diff options
Diffstat (limited to 'lisp/allout.el')
| -rw-r--r-- | lisp/allout.el | 1428 |
1 files changed, 482 insertions, 946 deletions
diff --git a/lisp/allout.el b/lisp/allout.el index b497c82f0b3..d965ac35338 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -1,12 +1,11 @@ ;;; allout.el --- extensive outline mode for use alone and with other modes -;; Copyright (C) 1992, 1993, 1994, 2001, 2002, 2003, 2004, 2005, 2006, -;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1992-1994, 2001-2011 Free Software Foundation, Inc. ;; Author: Ken Manheimer <ken dot manheimer at gmail dot com> ;; Maintainer: Ken Manheimer <ken dot manheimer at gmail dot com> ;; Created: Dec 1991 -- first release to usenet -;; Version: 2.2.2 +;; Version: 2.3 ;; Keywords: outlines wp languages ;; Website: http://myriadicity.net/Sundry/EmacsAllout @@ -43,9 +42,8 @@ ;; - Symmetric-key and key-pair topic encryption, plus symmetric passphrase ;; mnemonic support, with verification against an established passphrase ;; (using a stashed encrypted dummy string) and user-supplied hint -;; maintenance. (See allout-toggle-current-subtree-encryption docstring. -;; Currently only GnuPG encryption is supported, and integration -;; with gpg-agent is not yet implemented.) +;; maintenance. Encryption is via the Emacs 'epg' library. See +;; allout-toggle-current-subtree-encryption docstring. ;; - Automatic topic-number maintenance ;; - "Hot-spot" operation, for single-keystroke maneuvering and ;; exposure control (see the allout-mode docstring) @@ -84,11 +82,10 @@ ;;;_* Dependency autoloads (require 'overlay) (eval-when-compile - ;; Most of the requires here are for stuff covered by autoloads. - ;; Since just byte-compiling doesn't trigger autoloads, so that - ;; "function not found" warnings would occur without these requires. - (require 'pgg) - (require 'pgg-gpg) + ;; Most of the requires here are for stuff covered by autoloads, which + ;; byte-compiling doesn't trigger. + (require 'epg) + (require 'epa) (require 'overlay) ;; `cl' is required for `assert'. `assert' is not covered by a standard ;; autoload, but it is a macro, so that eval-when-compile is sufficient @@ -110,23 +107,39 @@ ;;;_ + Layout, Mode, and Topic Header Configuration (defvar allout-command-prefix) ; defined below -(defvar allout-mode-map) ;;;_ > allout-keybindings incidentals: -;;;_ > allout-bind-keys &optional varname value -(defun allout-bind-keys (&optional varname value) - "Rebuild the `allout-mode-map' according to the keybinding specs. - -Useful standalone, to init the map, or in customizing the +;;;_ : internal key binding stuff - in this section for load-order. +;;;_ = allout-mode-map +(defvar allout-mode-map 'allout-mode-map + "Keybindings place-holder for (allout) outline minor mode. + +Do NOT set the value of this variable. Instead, customize +`allout-command-prefix', `allout-prefixed-keybindings', and +`allout-unprefixed-keybindings'.") +;;;_ = allout-mode-map-value +(defvar allout-mode-map-value nil + "Keymap for allout outline minor mode. + +Do NOT set the value of this variable. Instead, customize +`allout-command-prefix', `allout-prefixed-keybindings', and +`allout-unprefixed-keybindings'.") +;;;_ = make allout-mode-map-value an alias for allout-mode-map: +;; this needs to be revised when the value is changed, sigh. +(defalias 'allout-mode-map allout-mode-map-value) +;;;_ > allout-compose-and-institute-keymap (&optional varname value) +(defun allout-compose-and-institute-keymap (&optional varname value) + "Create the allout keymap according to the keybinding specs, and set it. + +Useful standalone or to effect customizations of the respective allout-mode keybinding variables, `allout-command-prefix', `allout-prefixed-keybindings', and `allout-unprefixed-keybindings'" ;; Set the customization variable, if any: (when varname (set-default varname value)) - (let ((map (make-sparse-keymap)) - key) + (let ((map (make-sparse-keymap))) (when (boundp 'allout-prefixed-keybindings) - ;; Be tolerant of the moments when the variables are first being defined. + ;; tolerate first definitions of the variables: (dolist (entry allout-prefixed-keybindings) (define-key map ;; XXX vector vs non-vector key descriptions? @@ -136,9 +149,34 @@ respective allout-mode keybinding variables, `allout-command-prefix', (when (boundp 'allout-unprefixed-keybindings) (dolist (entry allout-unprefixed-keybindings) (define-key map (car (read-from-string (car entry))) (cadr entry)))) - (setq allout-mode-map map) - map - )) + (substitute-key-definition 'beginning-of-line 'allout-beginning-of-line + map global-map) + (substitute-key-definition 'move-beginning-of-line 'allout-beginning-of-line + map global-map) + (substitute-key-definition 'end-of-line 'allout-end-of-line + map global-map) + (substitute-key-definition 'move-end-of-line 'allout-end-of-line + map global-map) + (allout-institute-keymap map))) +;;;_ > allout-institute-keymap (map) +(defun allout-institute-keymap (map) + "Associate allout-mode bindings with allout as a minor mode." + ;; Architecture: + ;; allout-mode-map var is a keymap by virtue of being a defalias for + ;; allout-mode-map-value, which has the actual keymap value. + ;; allout-mode-map's symbol value is just 'allout-mode-map, so it can be + ;; used in minor-mode-map-alist to indirect to the actual + ;; allout-mode-map-var value, which can be adjusted and reassigned. + + ;; allout-mode-map-value for keymap reference in various places: + (setq allout-mode-map-value map) + ;; the function value keymap of allout-mode-map is used in + ;; minor-mode-map-alist - update it: + (fset allout-mode-map allout-mode-map-value)) +;;;_ * intialize the mode map: +;; ensure that allout-mode-map has some setting even if allout-mode hasn't +;; been invoked: +(allout-compose-and-institute-keymap) ;;;_ = allout-command-prefix (defcustom allout-command-prefix "\C-c " "Key sequence to be used as prefix for outline mode command key bindings. @@ -147,7 +185,7 @@ Default is '\C-c<space>'; just '\C-c' is more short-and-sweet, if you're willing to let allout use a bunch of \C-c keybindings." :type 'string :group 'allout-keybindings - :set 'allout-bind-keys) + :set 'allout-compose-and-institute-keymap) ;;;_ = allout-keybindings-binding (define-widget 'allout-keybindings-binding 'lazy "Structure of allout keybindings customization items." @@ -159,16 +197,16 @@ willing to let allout use a bunch of \C-c keybindings." (defcustom allout-prefixed-keybindings '(("[(control ?n)]" allout-next-visible-heading) ("[(control ?p)]" allout-previous-visible-heading) -;; ("[(control ?u)]" allout-up-current-level) + ("[(control ?u)]" allout-up-current-level) ("[(control ?f)]" allout-forward-current-level) ("[(control ?b)]" allout-backward-current-level) ("[(control ?a)]" allout-beginning-of-current-entry) ("[(control ?e)]" allout-end-of-entry) ("[(control ?i)]" allout-show-children) - ("[(control ?i)]" allout-show-children) ("[(control ?s)]" allout-show-current-subtree) ("[(control ?t)]" allout-toggle-current-subtree-exposure) - ("[(control ?h)]" allout-hide-current-subtree) +;; Let user customize if they want to preempt describe-prefix-bindings ^h use. +;; ("[(control ?h)]" allout-hide-current-subtree) ("[?h]" allout-hide-current-subtree) ("[(control ?o)]" allout-show-current-entry) ("[?!]" allout-show-all) @@ -181,9 +219,9 @@ willing to let allout use a bunch of \C-c keybindings." ("[?<]" allout-shift-out) ("[(control ?m)]" allout-rebullet-topic) ("[?*]" allout-rebullet-current-heading) - ("[?']" allout-number-siblings) + ("[?#]" allout-number-siblings) ("[(control ?k)]" allout-kill-topic) - ("[??]" allout-copy-topic-as-kill) + ("[(meta ?k)]" allout-copy-topic-as-kill) ("[?@]" allout-resolve-xref) ("[?=?c]" allout-copy-exposed-to-buffer) ("[?=?i]" allout-indented-exposed-to-buffer) @@ -207,14 +245,14 @@ multiple functions will not work - the last binding for a key prevails." :type 'allout-keybindings-binding :group 'allout-keybindings - :set 'allout-bind-keys + :set 'allout-compose-and-institute-keymap ) ;;;_ = allout-unprefixed-keybindings (defcustom allout-unprefixed-keybindings '(("[(control ?k)]" allout-kill-line) - ("[??(meta ?k)]" allout-copy-line-as-kill) + ("[(meta ?k)]" allout-copy-line-as-kill) ("[(control ?y)]" allout-yank) - ("[??(meta ?y)]" allout-yank-pop) + ("[(meta ?y)]" allout-yank-pop) ) "Allout-mode functions bound to keys without any added prefix. @@ -230,69 +268,9 @@ Use vector format for the keys: See the existing keys for examples." :type 'allout-keybindings-binding :group 'allout-keybindings - :set 'allout-bind-keys + :set 'allout-compose-and-institute-keymap ) -;;;_ = allout-preempt-trailing-ctrl-h -(defcustom allout-preempt-trailing-ctrl-h nil - "Use <prefix>-\C-h, instead of leaving it for describe-prefix-bindings?" - :type 'boolean - :group 'allout) - -;;;_ = allout-keybindings-list -;;; You have to reactivate allout-mode -- `(allout-mode t)' -- to -;;; institute changes to this var. -(defvar allout-keybindings-list () - "*List of `allout-mode' key / function bindings, for `allout-mode-map'. -String or vector key will be prefaced with `allout-command-prefix', -unless optional third, non-nil element is present.") -(setq allout-keybindings-list - '( - ; Motion commands: - ("\C-n" allout-next-visible-heading) - ("\C-p" allout-previous-visible-heading) - ("\C-u" allout-up-current-level) - ("\C-f" allout-forward-current-level) - ("\C-b" allout-backward-current-level) - ("\C-a" allout-beginning-of-current-entry) - ("\C-e" allout-end-of-entry) - ; Exposure commands: - ([(control i)] allout-show-children) ; xemacs translates "\C-i" to tab - ("\C-i" allout-show-children) ; but we still need this for hotspot - ("\C-s" allout-show-current-subtree) - ;; binding to \C-h is included if allout-preempt-trailing-ctrl-h, - ;; so user controls whether or not to preempt the conventional ^H - ;; binding to help-command. - ("\C-h" allout-hide-current-subtree) - ("\C-t" allout-toggle-current-subtree-exposure) - ("h" allout-hide-current-subtree) - ("\C-o" allout-show-current-entry) - ("!" allout-show-all) - ("x" allout-toggle-current-subtree-encryption) - ; Alteration commands: - (" " allout-open-sibtopic) - ("." allout-open-subtopic) - ("," allout-open-supertopic) - ("'" allout-shift-in) - (">" allout-shift-in) - ("<" allout-shift-out) - ("\C-m" allout-rebullet-topic) - ("*" allout-rebullet-current-heading) - ("#" allout-number-siblings) - ("\C-k" allout-kill-line t) - ([?\M-k] allout-copy-line-as-kill t) - ("\C-y" allout-yank t) - ([?\M-y] allout-yank-pop t) - ("\C-k" allout-kill-topic) - ([?\M-k] allout-copy-topic-as-kill) - ; Miscellaneous commands: - ;([?\C-\ ] allout-mark-topic) - ("@" allout-resolve-xref) - ("=c" allout-copy-exposed-to-buffer) - ("=i" allout-indented-exposed-to-buffer) - ("=t" allout-latexify-exposed) - ("=p" allout-flatten-exposed-to-buffer))) - ;;;_ = allout-auto-activation (defcustom allout-auto-activation nil "Regulates auto-activation modality of allout outlines -- see `allout-init'. @@ -572,7 +550,7 @@ themselves: `!' - exclamation point/bang -- emphatic `[' - open square bracket -- meta-note, about item instead of item's subject `\"' - double quote -- a quotation or other citation - `=' - equal sign -- an assignement, equating a name with some connotation + `=' - equal sign -- an assignment, some kind of definition `^' - carat -- relates to something above Some are more elusive, but their rationale may be recognizable: @@ -818,32 +796,6 @@ formatted copy." :type '(choice (const nil) string) :version "22.1" :group 'allout-encryption) -;;;_ = allout-passphrase-verifier-handling -(defcustom allout-passphrase-verifier-handling t - "Enable use of symmetric encryption passphrase verifier if non-nil. - -See the docstring for the `allout-enable-file-variable-adjustment' -variable for details about allout ajustment of file variables." - :type 'boolean - :version "22.1" - :group 'allout-encryption) -(make-variable-buffer-local 'allout-passphrase-verifier-handling) -;;;_ = allout-passphrase-hint-handling -(defcustom allout-passphrase-hint-handling 'always - "Dictate outline encryption passphrase reminder handling: - - always -- always show reminder when prompting - needed -- show reminder on passphrase entry failure - disabled -- never present or adjust reminder - -See the docstring for the `allout-enable-file-variable-adjustment' -variable for details about allout ajustment of file variables." - :type '(choice (const always) - (const needed) - (const disabled)) - :version "22.1" - :group 'allout-encryption) -(make-variable-buffer-local 'allout-passphrase-hint-handling) ;;;_ = allout-encrypt-unencrypted-on-saves (defcustom allout-encrypt-unencrypted-on-saves t "When saving, should topics pending encryption be encrypted? @@ -920,7 +872,7 @@ For details, see `allout-toggle-current-subtree-encryption's docstring." ;;;_ #1 Internal Outline Formatting and Configuration ;;;_ : Version ;;;_ = allout-version -(defvar allout-version "2.2.2" +(defvar allout-version "2.3" "Version of currently loaded outline package. (allout.el)") ;;;_ > allout-version (defun allout-version (&optional here) @@ -1268,36 +1220,6 @@ Also refresh various data structures that hinge on the regexp." "[^" allout-primary-bullet "]")) "\\)" )))) -;;;_ : Key bindings -;;;_ = allout-mode-map -(defvar allout-mode-map nil "Keybindings for (allout) outline minor mode.") -;;;_ > produce-allout-mode-map (keymap-alist &optional base-map) -(defun produce-allout-mode-map (keymap-list &optional base-map) - "Produce keymap for use as `allout-mode-map', from KEYMAP-LIST. - -Built on top of optional BASE-MAP, or empty sparse map if none specified. -See doc string for `allout-keybindings-list' for format of binding list." - (let ((map (or base-map (make-sparse-keymap))) - (pref (list allout-command-prefix))) - (mapc (function - (lambda (cell) - (let ((add-pref (null (cdr (cdr cell)))) - (key-suff (list (car cell)))) - (apply 'define-key - (list map - (apply 'vconcat (if add-pref - (append pref key-suff) - key-suff)) - (car (cdr cell))))))) - keymap-list) - map)) -;;;_ > allout-mode-map-adjustments (base-map) -(defun allout-mode-map-adjustments (base-map) - "Do conditional additions to specified base-map, like inclusion of \\C-h." - (if allout-preempt-trailing-ctrl-h - (cons '("\C-h" allout-hide-current-subtree) base-map) - base-map) - ) ;;;_ : Menu bar (defvar allout-mode-exposure-menu) (defvar allout-mode-editing-menu) @@ -1306,7 +1228,7 @@ See doc string for `allout-keybindings-list' for format of binding list." (defun produce-allout-mode-menubar-entries () (require 'easymenu) (easy-menu-define allout-mode-exposure-menu - allout-mode-map + allout-mode-map-value "Allout outline exposure menu." '("Exposure" ["Show Entry" allout-show-current-entry t] @@ -1317,7 +1239,7 @@ See doc string for `allout-keybindings-list' for format of binding list." "----" ["Show All" allout-show-all t])) (easy-menu-define allout-mode-editing-menu - allout-mode-map + allout-mode-map-value "Allout outline editing menu." '("Headings" ["Open Sibling" allout-open-sibtopic t] @@ -1334,7 +1256,7 @@ See doc string for `allout-keybindings-list' for format of binding list." allout-toggle-current-subtree-encryption (> (allout-current-depth) 1)])) (easy-menu-define allout-mode-navigation-menu - allout-mode-map + allout-mode-map-value "Allout outline navigation menu." '("Navigation" ["Next Visible Heading" allout-next-visible-heading t] @@ -1351,7 +1273,7 @@ See doc string for `allout-keybindings-list' for format of binding list." ["End of Entry" allout-end-of-entry t] ["End of Subtree" allout-end-of-current-subtree t])) (easy-menu-define allout-mode-misc-menu - allout-mode-map + allout-mode-map-value "Allout outlines miscellaneous bindings." '("Misc" ["Version" allout-version t] @@ -1461,17 +1383,11 @@ their settings before allout-mode was started." ;;;_ = allout-mode-deactivate-hook (defvar allout-mode-deactivate-hook nil "*Hook that's run when allout mode ends.") +(define-obsolete-variable-alias 'allout-mode-deactivate-hook + 'allout-mode-off-hook "future") ;;;_ = allout-exposure-category (defvar allout-exposure-category nil "Symbol for use as allout invisible-text overlay category.") -;;;_ x allout-view-change-hook -(defvar allout-view-change-hook nil - "*(Deprecated) A hook run after allout outline exposure changes. - -Switch to using `allout-exposure-change-hook' instead. Both hooks are -currently respected, but the other conveys the details of the exposure -change via explicit parameters, and this one will eventually be disabled in -a subsequent allout version.") ;;;_ = allout-exposure-change-hook (defvar allout-exposure-change-hook nil "*Hook that's run after allout outline subtree exposure changes. @@ -1484,10 +1400,7 @@ Functions on the hook must take three arguments: - TO -- integer indicating the point of the end of the change. - FLAG -- change mode: nil for exposure, otherwise concealment. -This hook might be invoked multiple times by a single command. - -This hook is replacing `allout-view-change-hook', which is being deprecated -and eventually will not be invoked.") +This hook might be invoked multiple times by a single command.") ;;;_ = allout-structure-added-hook (defvar allout-structure-added-hook nil "*Hook that's run after addition of items to the outline. @@ -1497,9 +1410,6 @@ Functions on the hook should take two arguments: - NEW-START -- integer indicating position of start of the first new item. - NEW-END -- integer indicating position of end of the last new item. -Some edits that introduce new items may missed by this hook: -specifically edits that native allout routines do not control. - This hook might be invoked multiple times by a single command.") ;;;_ = allout-structure-deleted-hook (defvar allout-structure-deleted-hook nil @@ -1534,11 +1444,8 @@ This hook might be invoked multiple times by a single command.") Used by allout-auto-fill to do the mandated normal-auto-fill-function wrapped within allout's automatic fill-prefix setting.") (make-variable-buffer-local 'allout-outside-normal-auto-fill-function) -;;;_ = file-var-bug hack -(defvar allout-v18/19-file-var-hack nil - "Horrible hack used to prevent invalid multiple triggering of outline -mode from prop-line file-var activation. Used by `allout-mode' function -to track repeats.") +;;;_ = prevent redundant activation by desktop mode: +(add-to-list 'desktop-minor-mode-handlers '(allout-mode . nil)) ;;;_ = allout-passphrase-verifier-string (defvar allout-passphrase-verifier-string nil "Setting used to test solicited encryption passphrases against the one @@ -1554,6 +1461,8 @@ The verifier string is retained as an Emacs file variable, as well as in the Emacs buffer state, if file variable adjustments are enabled. See `allout-enable-file-variable-adjustment' for details about that.") (make-variable-buffer-local 'allout-passphrase-verifier-string) +(make-obsolete 'allout-passphrase-verifier-string + 'allout-passphrase-verifier-string "23.3") ;;;###autoload (put 'allout-passphrase-verifier-string 'safe-local-variable 'stringp) ;;;_ = allout-passphrase-hint-string @@ -1568,6 +1477,8 @@ state, if file variable adjustments are enabled. See `allout-enable-file-variable-adjustment' for details about that.") (make-variable-buffer-local 'allout-passphrase-hint-string) (setq-default allout-passphrase-hint-string "") +(make-obsolete 'allout-passphrase-hint-string + 'allout-passphrase-hint-string "23.3") ;;;###autoload (put 'allout-passphrase-hint-string 'safe-local-variable 'stringp) ;;;_ = allout-after-save-decrypt @@ -1599,15 +1510,15 @@ substition is used against the regexp matches, a la `replace-match'.") (defvar allout-encryption-ciphertext-rejection-regexps nil "Variable for regexps matching plaintext to remove before encryption. -This is for the sake of redoing encryption in cases where the ciphertext -incidentally contains strings that would disrupt mode operation -- -for example, a line that happens to look like an allout-mode topic prefix. +This is used to detect strings in encryption results that would +register as allout mode structural elements, for exmple, as a +topic prefix. Entries must be symbols that are bound to the desired regexp values. -The encryption will be retried up to -`allout-encryption-ciphertext-rejection-limit' times, after which an error -is raised.") +Encryptions that result in matches will be retried, up to +`allout-encryption-ciphertext-rejection-limit' times, after which +an error is raised.") (make-variable-buffer-local 'allout-encryption-ciphertext-rejection-regexps) ;;;_ = allout-encryption-ciphertext-rejection-ceiling @@ -1813,24 +1724,22 @@ the following two lines in your Emacs init file: '(allout-overlay-insert-in-front-handler))) (put 'allout-exposure-category 'modification-hooks '(allout-overlay-interior-modification-handler))) -;;;_ > allout-mode (&optional toggle) +;;;_ > define-minor-mode allout-mode ;;;_ : Defun: ;;;###autoload -(defun allout-mode (&optional toggle) +(define-minor-mode allout-mode ;;;_ . Doc string: "Toggle minor mode for controlling exposure and editing of text outlines. -\\<allout-mode-map> +\\<allout-mode-map-value> -Optional prefix argument TOGGLE forces the mode to re-initialize -if it is positive, otherwise it turns the mode off. Allout -outline mode always runs as a minor mode. +Allout outline mode always runs as a minor mode. -Allout outline mode provides extensive outline oriented formatting and -manipulation. It enables structural editing of outlines, as well as -navigation and exposure. It also is specifically aimed at -accommodating syntax-sensitive text like programming languages. (For -an example, see the allout code itself, which is organized as an allout -outline.) +Allout outline mode provides extensive outline oriented +formatting and manipulation. It enables structural editing of +outlines, as well as navigation and exposure. It also is +specifically aimed at accommodating syntax-sensitive text like +programming languages. \(For example, see the allout code itself, +which is organized as an allout outline.) In addition to typical outline navigation and exposure, allout includes: @@ -1838,27 +1747,30 @@ In addition to typical outline navigation and exposure, allout includes: repositioning, promotion/demotion, cut, and paste - incremental search with dynamic exposure and reconcealment of hidden text - adjustable format, so programming code can be developed in outline-structure - - easy topic encryption and decryption + - easy topic encryption and decryption, symmetric or key-pair - \"Hot-spot\" operation, for single-keystroke maneuvering and exposure control - integral outline layout, for automatic initial exposure when visiting a file - independent extensibility, using comprehensive exposure and authoring hooks and many other features. -Below is a description of the key bindings, and then explanation of -special `allout-mode' features and terminology. See also the outline -menubar additions for quick reference to many of the features, and see -the docstring of the function `allout-init' for instructions on -priming your emacs session for automatic activation of `allout-mode'. - -The bindings are dictated by the customizable `allout-keybindings-list' -variable. We recommend customizing `allout-command-prefix' to use just -`\\C-c' as the command prefix, if the allout bindings don't conflict with -any personal bindings you have on \\C-c. In any case, outline structure -navigation and authoring is simplified by positioning the cursor on an -item's bullet character, the \"hot-spot\" -- then you can invoke allout -commands with just the un-prefixed, un-control-shifted command letters. -This is described further in the HOT-SPOT Operation section. +Below is a description of the key bindings, and then description +of special `allout-mode' features and terminology. See also the +outline menubar additions for quick reference to many of the +features, and see the docstring of the function `allout-init' for +instructions on priming your emacs session for automatic +activation of `allout-mode'. + +The bindings are those listed in `allout-prefixed-keybindings' +and `allout-unprefixed-keybindings'. We recommend customizing +`allout-command-prefix' to use just `\\C-c' as the command +prefix, if the allout bindings don't conflict with any personal +bindings you have on \\C-c. In any case, outline structure +navigation and authoring is simplified by positioning the cursor +on an item's bullet character, the \"hot-spot\" -- then you can +invoke allout commands with just the un-prefixed, +un-control-shifted command letters. This is described further in +the HOT-SPOT Operation section. Exposure Control: ---------------- @@ -1937,19 +1849,22 @@ M-x outlineify-sticky Activate outline mode for current buffer, Topic Encryption Outline mode supports gpg encryption of topics, with support for -symmetric and key-pair modes, passphrase timeout, passphrase -consistency checking, user-provided hinting for symmetric key -mode, and auto-encryption of topics pending encryption on save. +symmetric and key-pair modes, and auto-encryption of topics +pending encryption on save. Topics pending encryption are, by default, automatically -encrypted during file saves. If the contents of the topic -containing the cursor was encrypted for a save, it is -automatically decrypted for continued editing. - -The aim of these measures is reliable topic privacy while -preventing accidents like neglected encryption before saves, -forgetting which passphrase was used, and other practical -pitfalls. +encrypted during file saves, including checkpoint saves, to avoid +exposing the plain text of encrypted topics in the file system. +If the content of the topic containing the cursor was encrypted +for a save, it is automatically decrypted for continued editing. + +NOTE: A few GnuPG v2 versions improperly preserve incorrect +symmetric decryption keys, preventing entry of the correct key on +subsequent decryption attempts until the cache times-out. That +can take several minutes. \(Decryption of other entries is not +affected.) Upgrade your EasyPG version, if you can, and you can +deliberately clear your gpg-agent's cache by sending it a '-HUP' +signal. See `allout-toggle-current-subtree-encryption' function docstring and `allout-encrypt-unencrypted-on-saves' customization variable @@ -1987,7 +1902,8 @@ hooks, by which independent code can cooperate with allout without changes to the allout core. Here are key ones: `allout-mode-hook' -`allout-mode-deactivate-hook' +`allout-mode-deactivate-hook' \(deprecated) +`allout-mode-off-hook' `allout-exposure-change-hook' `allout-structure-added-hook' `allout-structure-deleted-hook' @@ -2074,76 +1990,41 @@ CONCEALED: CLOSED: A TOPIC whose immediate OFFSPRING and body-text is CONCEALED. OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be." ;;;_ . Code - (interactive "P") - - (let* ((active (and (not (equal major-mode 'outline)) - (allout-mode-p))) - ; Massage universal-arg `toggle' val: - (toggle (and toggle - (or (and (listp toggle)(car toggle)) - toggle))) - ; Activation specifically demanded? - (explicit-activation (and toggle - (or (symbolp toggle) - (and (wholenump toggle) - (not (zerop toggle)))))) - ;; allout-mode already called once during this complex command? - (same-complex-command (eq allout-v18/19-file-var-hack - (car command-history))) - (write-file-hook-var-name (cond ((boundp 'write-file-functions) - 'write-file-functions) - ((boundp 'write-file-hooks) - 'write-file-hooks) - (t 'local-write-file-hooks))) - do-layout - ) - - ; See comments below re v19.18,.19 bug. - (setq allout-v18/19-file-var-hack (car command-history)) - - (cond - - ;; Provision for v19.18, 19.19 bug -- - ;; Emacs v 19.18, 19.19 file-var code invokes prop-line-designated - ;; modes twice when file is visited. We have to avoid toggling mode - ;; off on second invocation, so we detect it as best we can, and - ;; skip everything. - ((and same-complex-command ; Still in same complex command - ; as last time `allout-mode' invoked. - active ; Already activated. - (not explicit-activation) ; Prop-line file-vars don't have args. - (string-match "^19.1[89]" ; Bug only known to be in v19.18 and - emacs-version)); 19.19. - t) - - ;; Deactivation: - ((and (not explicit-activation) - (or active toggle)) - ; Activation not explicitly - ; requested, and either in - ; active state or *de*activation - ; specifically requested: - (setq allout-explicitly-deactivated t) - - (allout-do-resumptions) - - (remove-from-invisibility-spec '(allout . t)) - (remove-hook 'pre-command-hook 'allout-pre-command-business t) - (remove-hook 'post-command-hook 'allout-post-command-business t) - (remove-hook 'before-change-functions 'allout-before-change-handler t) - (remove-hook 'isearch-mode-end-hook 'allout-isearch-end-handler t) - (remove-hook write-file-hook-var-name 'allout-write-file-hook-handler t) - (remove-hook 'auto-save-hook 'allout-auto-save-hook-handler t) - - (remove-overlays (point-min) (point-max) - 'category 'allout-exposure-category) - - (setq allout-mode nil) - (run-hooks 'allout-mode-deactivate-hook)) - - ;; Activation: - ((not active) - (setq allout-explicitly-deactivated nil) + :lighter " Allout" + :keymap 'allout-mode-map + + (let ((write-file-hook-var-name (cond ((boundp 'write-file-functions) + 'write-file-functions) + ((boundp 'write-file-hooks) + 'write-file-hooks) + (t 'local-write-file-hooks))) + (use-layout (if (listp allout-layout) + allout-layout + allout-default-layout))) + + (if (not (allout-mode-p)) + (progn + ;; Deactivation: + + ; Activation not explicitly + ; requested, and either in + ; active state or *de*activation + ; specifically requested: + (allout-do-resumptions) + + (remove-from-invisibility-spec '(allout . t)) + (remove-hook 'pre-command-hook 'allout-pre-command-business t) + (remove-hook 'post-command-hook 'allout-post-command-business t) + (remove-hook 'before-change-functions 'allout-before-change-handler t) + (remove-hook 'isearch-mode-end-hook 'allout-isearch-end-handler t) + (remove-hook write-file-hook-var-name + 'allout-write-file-hook-handler t) + (remove-hook 'auto-save-hook 'allout-auto-save-hook-handler t) + + (remove-overlays (point-min) (point-max) + 'category 'allout-exposure-category)) + + ;; Activating: (if allout-old-style-prefixes ;; Inhibit all the fancy formatting: (allout-add-resumptions '(allout-primary-bullet "*"))) @@ -2154,45 +2035,31 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be." (allout-infer-body-reindent) (set-allout-regexp) - (allout-add-resumptions - '(allout-encryption-ciphertext-rejection-regexps - allout-line-boundary-regexp - extend) - '(allout-encryption-ciphertext-rejection-regexps - allout-bob-regexp - extend)) - - ;; Produce map from current version of allout-keybindings-list: - (allout-setup-mode-map) + (allout-add-resumptions '(allout-encryption-ciphertext-rejection-regexps + allout-line-boundary-regexp + extend) + '(allout-encryption-ciphertext-rejection-regexps + allout-bob-regexp + extend)) + + (allout-compose-and-institute-keymap) (produce-allout-mode-menubar-entries) - ;; Include on minor-mode-map-alist, if not already there: - (if (not (member '(allout-mode . allout-mode-map) - minor-mode-map-alist)) - (setq minor-mode-map-alist - (cons '(allout-mode . allout-mode-map) - minor-mode-map-alist))) - (add-to-invisibility-spec '(allout . t)) (allout-add-resumptions '(line-move-ignore-invisible t)) (add-hook 'pre-command-hook 'allout-pre-command-business nil t) (add-hook 'post-command-hook 'allout-post-command-business nil t) - (add-hook 'before-change-functions 'allout-before-change-handler - nil t) + (add-hook 'before-change-functions 'allout-before-change-handler nil t) (add-hook 'isearch-mode-end-hook 'allout-isearch-end-handler nil t) (add-hook write-file-hook-var-name 'allout-write-file-hook-handler nil t) - (add-hook 'auto-save-hook 'allout-auto-save-hook-handler - nil t) + (add-hook 'auto-save-hook 'allout-auto-save-hook-handler nil t) ;; Stash auto-fill settings and adjust so custom allout auto-fill ;; func will be used if auto-fill is active or activated. (The ;; custom func respects topic headline, maintains hanging-indents, ;; etc.) - (if (and auto-fill-function (not allout-inhibit-auto-fill)) - ;; allout-auto-fill will use the stashed values and so forth. - (allout-add-resumptions '(auto-fill-function allout-auto-fill))) (allout-add-resumptions (list 'allout-former-auto-filler auto-fill-function) ;; Register allout-auto-fill to be used if @@ -2207,91 +2074,51 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be." (list 'paragraph-separate (concat paragraph-separate "\\|^\\(" allout-regexp "\\)"))) - (or (assq 'allout-mode minor-mode-alist) - (setq minor-mode-alist - (cons '(allout-mode " Allout") minor-mode-alist))) + (if (and auto-fill-function (not allout-inhibit-auto-fill)) + ;; allout-auto-fill will use the stashed values and so forth. + (allout-add-resumptions '(auto-fill-function allout-auto-fill))) (allout-setup-menubar) - (if allout-layout - (setq do-layout t)) - - (setq allout-mode t) - (run-hooks 'allout-mode-hook)) - - ;; Reactivation: - ((setq do-layout t) - (allout-infer-body-reindent)) - ) ;; end of activation-mode cases. - - ;; Do auto layout if warranted: - (let ((use-layout (if (listp allout-layout) - allout-layout - allout-default-layout))) - (if (and do-layout - allout-auto-activation - use-layout - (and (not (eq allout-auto-activation 'activate)) - (if (eq allout-auto-activation 'ask) - (if (y-or-n-p (format "Expose %s with layout '%s'? " - (buffer-name) - use-layout)) - t - (message "Skipped %s layout." (buffer-name)) - nil) - t))) - (save-excursion - (message "Adjusting '%s' exposure..." (buffer-name)) - (goto-char 0) - (allout-this-or-next-heading) - (condition-case err - (progn - (apply 'allout-expose-topic (list use-layout)) - (message "Adjusting '%s' exposure... done." (buffer-name))) - ;; Problem applying exposure -- notify user, but don't - ;; interrupt, eg, file visit: - (error (message "%s" (car (cdr err))) - (sit-for 1)))))) - allout-mode - ) ; let* - ) ; defun - -(defun allout-setup-mode-map () - "Establish allout-mode bindings." - (setq-default allout-mode-map - (produce-allout-mode-map - (allout-mode-map-adjustments allout-keybindings-list))) - (setq allout-mode-map - (produce-allout-mode-map - (allout-mode-map-adjustments allout-keybindings-list))) - (substitute-key-definition 'beginning-of-line - 'allout-beginning-of-line - allout-mode-map global-map) - (substitute-key-definition 'move-beginning-of-line - 'allout-beginning-of-line - allout-mode-map global-map) - (substitute-key-definition 'end-of-line - 'allout-end-of-line - allout-mode-map global-map) - (substitute-key-definition 'move-end-of-line - 'allout-end-of-line - allout-mode-map global-map) - (fset 'allout-mode-map allout-mode-map)) - -;; ensure that allout-mode-map has some setting even if allout-mode hasn't -;; been invoked: -(allout-setup-mode-map) - -;;;_ > allout-minor-mode + ;; Do auto layout if warranted: + (when (and allout-layout + allout-auto-activation + use-layout + (and (not (eq allout-auto-activation 'activate)) + (if (eq allout-auto-activation 'ask) + (if (y-or-n-p (format "Expose %s with layout '%s'? " + (buffer-name) + use-layout)) + t + (message "Skipped %s layout." (buffer-name)) + nil) + t))) + (save-excursion + (message "Adjusting '%s' exposure..." (buffer-name)) + (goto-char 0) + (allout-this-or-next-heading) + (condition-case err + (progn + (apply 'allout-expose-topic (list use-layout)) + (message "Adjusting '%s' exposure... done." + (buffer-name))) + ;; Problem applying exposure -- notify user, but don't + ;; interrupt, eg, file visit: + (error (message "%s" (car (cdr err))) + (sit-for 1)))) + ) ; when allout-layout + ) ; if (allout-mode-p) + ) ; let (()) + ) ; define-minor-mode +;;;_ > allout-minor-mode alias (defalias 'allout-minor-mode 'allout-mode) - ;;;_ > allout-unload-function (defun allout-unload-function () "Unload the allout outline library." (save-current-buffer (dolist (buffer (buffer-list)) (set-buffer buffer) - (when allout-mode (allout-mode -1)))) + (when (allout-mode-p) (allout-mode)))) ;; continue standard unloading nil) @@ -2360,8 +2187,8 @@ internal functions use this feature cohesively bunch changes." See `allout-overlay-interior-modification-handler' for details." - (if (and (allout-mode-p) undo-in-progress (allout-hidden-p)) - (allout-show-to-offshoot)) + (when (and (allout-mode-p) undo-in-progress (allout-hidden-p)) + (allout-show-children)) ;; allout-overlay-interior-modification-handler on an overlay handles ;; this in other emacs, via `allout-exposure-category's 'modification-hooks. @@ -3058,13 +2885,19 @@ of (before any) topics, in which case we return nil." (allout-beginning-of-current-line) (let ((bol-point (point))) - (if (allout-goto-prefix-doublechecked) - (if (<= (point) bol-point) + (when (allout-goto-prefix-doublechecked) + (if (<= (point) bol-point) + (progn + (setq bol-point (point)) + (allout-beginning-of-current-line) + (if (not (= bol-point (point))) + (if (looking-at allout-regexp) + (allout-prefix-data))) (if interactive (allout-end-of-prefix) - (point)) - (goto-char (point-min)) - nil)))) + (point))) + (goto-char (point-min)) + nil)))) ;;;_ > allout-back-to-heading () (defalias 'allout-back-to-heading 'allout-back-to-current-heading) ;;;_ > allout-pre-next-prefix () @@ -3389,6 +3222,7 @@ Move to buffer limit in indicated direction if headings are exhausted." (let* ((inhibit-field-text-motion t) (backward (if (< arg 0) (setq arg (* -1 arg)))) (step (if backward -1 1)) + (progress (allout-current-bullet-pos)) prev got) (while (> arg 0) @@ -3398,7 +3232,17 @@ Move to buffer limit in indicated direction if headings are exhausted." ;; Move, skipping over all concealed lines in one fell swoop: (prog1 (condition-case nil (or (line-move step) t) (error nil)) - (allout-beginning-of-current-line)) + (allout-beginning-of-current-line) + ;; line-move can wind up on the same line if long. + ;; when moving forward, that would yield no-progress + (when (and (not backward) + (<= (point) progress)) + ;; ensure progress by doing line-move from end-of-line: + (end-of-line) + (condition-case nil (or (line-move step) t) + (error nil)) + (allout-beginning-of-current-line) + (setq progress (point)))) ;; Deal with apparent header line: (save-match-data (if (not (looking-at allout-regexp)) @@ -3481,7 +3325,7 @@ When set, tells post-processing to reposition on topic bullet, and then unset it. Set by `allout-pre-command-business' when implementing hot-spot operation, where literal characters typed over a topic bullet are mapped to the command of the corresponding control-key on the -`allout-mode-map'.") +`allout-mode-map-value'.") (make-variable-buffer-local 'allout-post-goto-bullet) ;;;_ = allout-command-counter (defvar allout-command-counter 0 @@ -3520,11 +3364,12 @@ coordinating with allout activity.") Among other things, implements special behavior when the cursor is on the topic bullet character. -When the cursor is on the bullet character, self-insert characters are -reinterpreted as the corresponding control-character in the -`allout-mode-map'. The `allout-mode' `post-command-hook' insures that -the cursor which has moved as a result of such reinterpretation is -positioned on the bullet character of the destination topic. +When the cursor is on the bullet character, self-insert +characters are reinterpreted as the corresponding +control-character in the `allout-mode-map-value'. The +`allout-mode' `post-command-hook' insures that the cursor which +has moved as a result of such reinterpretation is positioned on +the bullet character of the destination topic. The upshot is that you can get easy, single (ie, unmodified) key outline maneuvering operations by positioning the cursor on the bullet @@ -3551,9 +3396,6 @@ this-command accordingly. Returns the qualifying command, if any, else nil." (interactive) (let* ((modified (event-modifiers last-command-event)) - (key-string (if (numberp last-command-event) - (char-to-string - (event-basic-type last-command-event)))) (key-num (cond ((numberp last-command-event) last-command-event) ;; for XEmacs character type: ((and (fboundp 'characterp) @@ -3570,16 +3412,18 @@ Returns the qualifying command, if any, else nil." (not modified) (<= 33 key-num) (setq mapped-binding - (or (and (assoc key-string allout-keybindings-list) - ;; translate literal membership on list: - (cadr (assoc key-string allout-keybindings-list))) - ;; translate as a keybinding: - (key-binding (vconcat allout-command-prefix - (vector - (if (and (<= 97 key-num) ; "a" - (>= 122 key-num)) ; "z" - (- key-num 96) key-num))) - t)))) + (or + ;; try control-modified versions of keys: + (key-binding (vconcat allout-command-prefix + (vector + (if (and (<= 97 key-num) ; "a" + (>= 122 key-num)) ; "z" + (- key-num 96) key-num))) + t) + ;; try non-modified versions of keys: + (key-binding (vconcat allout-command-prefix + (vector key-num)) + t)))) ;; Qualified as an allout command -- do hot-spot operation. (setq allout-post-goto-bullet t) ;; accept-defaults nil, or else we get allout-item-icon-key-handler. @@ -3600,7 +3444,7 @@ See `allout-init' for setup instructions." (if (and allout-auto-activation (not (allout-mode-p)) allout-layout) - (allout-mode t))) + (allout-mode))) ;;;_ - Topic Format Assessment ;;;_ > allout-solicit-alternate-bullet (depth &optional current-bullet) @@ -4047,9 +3891,13 @@ Maintains outline hanging topic indentation if (make-string (progn (allout-end-of-prefix) (current-column)) ?\ )))))) - (use-auto-fill-function (or allout-outside-normal-auto-fill-function - auto-fill-function - 'do-auto-fill))) + (use-auto-fill-function + (if (and (eq allout-outside-normal-auto-fill-function + 'allout-auto-fill) + (eq auto-fill-function 'allout-auto-fill)) + 'do-auto-fill + (or allout-outside-normal-auto-fill-function + auto-fill-function)))) (if (or allout-former-auto-filler allout-use-hanging-indents) (funcall use-auto-fill-function))))) ;;;_ > allout-reindent-body (old-depth new-depth &optional number) @@ -4914,9 +4762,7 @@ by pops to non-distinctive yanks. Bug..." "Conceal text between FROM and TO if FLAG is non-nil, else reveal it. Exposure-change hook `allout-exposure-change-hook' is run with the same -arguments as this function, after the exposure changes are made. (The old -`allout-view-change-hook' is being deprecated, and eventually will not be -invoked.)" +arguments as this function, after the exposure changes are made." ;; We use outline invisibility spec. (remove-overlays from to 'category 'allout-exposure-category) @@ -4930,7 +4776,6 @@ invoked.)" ;; as of 2008-02-27, xemacs lacks modification-hooks (overlay-put o (pop props) (pop props)) (error nil))))))) - (run-hooks 'allout-view-change-hook) (run-hook-with-args 'allout-exposure-change-hook from to flag)) ;;;_ > allout-flag-current-subtree (flag) (defun allout-flag-current-subtree (flag) @@ -5132,7 +4977,8 @@ default, they are treated as being uncollapsed." (and ;; Is the topic all on one line (allowing for trailing blank line)? (>= (progn (allout-back-to-current-heading) - (move-end-of-line 1) + (let ((inhibit-field-text-motion t)) + (move-end-of-line 1)) (point)) (allout-end-of-current-subtree (not (looking-at "\n\n")))) @@ -5999,31 +5845,39 @@ With repeat count, copy the exposed portions of entire buffer." (goto-char start-pt))) ;;;_ #8 Encryption -;;;_ > allout-toggle-current-subtree-encryption (&optional fetch-pass) -(defun allout-toggle-current-subtree-encryption (&optional fetch-pass) - "Encrypt clear or decrypt encoded text of visibly-containing topic's contents. - -Optional FETCH-PASS universal argument provokes key-pair encryption with -single universal argument. With doubled universal argument (value = 16), -it forces prompting for the passphrase regardless of availability from the -passphrase cache. With no universal argument, the appropriate passphrase -is obtained from the cache, if available, else from the user. - -Only GnuPG encryption is supported. - -\*NOTE WELL* that the encrypted text must be ascii-armored. For gnupg -encryption, include the option ``armor'' in your ~/.gnupg/gpg.conf file. - -Both symmetric-key and key-pair encryption is implemented. Symmetric is -the default, use a single (x4) universal argument for keypair mode. - -Encrypted topic's bullet is set to a `~' to signal that the contents of the -topic (body and subtopics, but not heading) is pending encryption or -encrypted. `*' asterisk immediately after the bullet signals that the body -is encrypted, its' absence means the topic is meant to be encrypted but is -not. When a file with topics pending encryption is saved, topics pending -encryption are encrypted. See allout-encrypt-unencrypted-on-saves for -auto-encryption specifics. +;;;_ > allout-toggle-current-subtree-encryption (&optional keymode-cue) +(defun allout-toggle-current-subtree-encryption (&optional keymode-cue) + "Encrypt clear or decrypt encoded topic text. + +Allout uses emacs 'epg' libary to perform encryption. Symmetric +and keypair encryption are supported. All encryption is ascii +armored. + +Entry encryption defaults to symmetric key mode unless keypair +recipients are associated with the file \(see +`epa-file-encrypt-to') or the function is invoked with a +\(KEYMODE-CUE) universal argument greater than 1. + +When encrypting, KEYMODE-CUE universal argument greater than 1 +causes prompting for recipients for public-key keypair +encryption. Selecting no recipients results in symmetric key +encryption. + +Further, encrypting with a KEYMODE-CUE universal argument greater +than 4 - eg, preceded by a doubled Ctrl-U - causes association of +the specified recipients with the file, replacing those currently +associated with it. This can be used to deassociate any +recipients with the file, by selecting no recipients in the +dialog. + +Encrypted topic's bullets are set to a `~' to signal that the +contents of the topic (body and subtopics, but not heading) is +pending encryption or encrypted. `*' asterisk immediately after +the bullet signals that the body is encrypted, its absence means +the topic is meant to be encrypted but is not currently. When a +file with topics pending encryption is saved, topics pending +encryption are encrypted. See allout-encrypt-unencrypted-on-saves +for auto-encryption specifics. \*NOTE WELL* that automatic encryption that happens during saves will default to symmetric encryption -- you must deliberately (re)encrypt key-pair @@ -6031,59 +5885,35 @@ encrypted topics if you want them to continue to use the key-pair cipher. Level-one topics, with prefix consisting solely of an `*' asterisk, cannot be encrypted. If you want to encrypt the contents of a top-level topic, use -\\[allout-shift-in] to increase its depth. - - Passphrase Caching - -The encryption passphrase is solicited if not currently available in the -passphrase cache from a recent encryption action. - -The solicited passphrase is retained for reuse in a cache, if enabled. See -`pgg-cache-passphrase' and `pgg-passphrase-cache-expiry' for details. - - Symmetric Passphrase Hinting and Verification - -If the file previously had no associated passphrase, or had a different -passphrase than specified, the user is prompted to repeat the new one for -corroboration. A random string encrypted by the new passphrase is set on -the buffer-specific variable `allout-passphrase-verifier-string', for -confirmation of the passphrase when next obtained, before encrypting or -decrypting anything with it. This helps avoid mistakenly shifting between -keys. - -If allout customization var `allout-passphrase-verifier-handling' is -non-nil, an entry for `allout-passphrase-verifier-string' and its value is -added to an Emacs 'local variables' section at the end of the file, which -is created if necessary. That setting is for retention of the passphrase -verifier across Emacs sessions. - -Similarly, `allout-passphrase-hint-string' stores a user-provided reminder -about their passphrase, and `allout-passphrase-hint-handling' specifies -when the hint is presented, or if passphrase hints are disabled. If -enabled (see the `allout-passphrase-hint-handling' docstring for details), -the hint string is stored in the local-variables section of the file, and -solicited whenever the passphrase is changed." +\\[allout-shift-in] to increase its depth." (interactive "P") (save-excursion (allout-back-to-current-heading) - (allout-toggle-subtree-encryption fetch-pass) - ) - ) -;;;_ > allout-toggle-subtree-encryption (&optional fetch-pass) -(defun allout-toggle-subtree-encryption (&optional fetch-pass) + (allout-toggle-subtree-encryption keymode-cue))) +;;;_ > allout-toggle-subtree-encryption (&optional keymode-cue) +(defun allout-toggle-subtree-encryption (&optional keymode-cue) "Encrypt clear text or decrypt encoded topic contents (body and subtopics.) -Optional FETCH-PASS universal argument provokes key-pair encryption with -single universal argument. With doubled universal argument (value = 16), -it forces prompting for the passphrase regardless of availability from the -passphrase cache. With no universal argument, the appropriate passphrase -is obtained from the cache, if available, else from the user. +Entry encryption defaults to symmetric key mode unless keypair +recipients are associated with the file \(see +`epa-file-encrypt-to') or the function is invoked with a +\(KEYMODE-CUE) universal argument greater than 1. + +When encrypting, KEYMODE-CUE universal argument greater than 1 +causes prompting for recipients for public-key keypair +encryption. Selecting no recipients results in symmetric key +encryption. -Currently only GnuPG encryption is supported, and integration -with gpg-agent is not yet implemented. +Further, encrypting with a KEYMODE-CUE universal argument greater +than 4 - eg, preceded by a doubled Ctrl-U - causes association of +the specified recipients with the file, replacing those currently +associated with it. This can be used to deassociate any +recipients with the file, by selecting no recipients in the +dialog. -\**NOTE WELL** that the encrypted text must be ascii-armored. For gnupg -encryption, include the option ``armor'' in your ~/.gnupg/gpg.conf file. +Encryption and decryption uses the emacs epg library. + +Encrypted text will be ascii-armored. See `allout-toggle-current-subtree-encryption' for more details." @@ -6121,16 +5951,6 @@ See `allout-toggle-current-subtree-encryption' for more details." (if was-encrypted "de" "en")) nil)) ;; Assess key parameters: - (key-info (or - ;; detect the type by which it is already encrypted - (and was-encrypted - (allout-encrypted-key-info subject-text)) - (and (member fetch-pass '(4 (4))) - '(keypair nil)) - '(symmetric nil))) - (for-key-type (car key-info)) - (for-key-identity (cadr key-info)) - (fetch-pass (and fetch-pass (member fetch-pass '(16 (16))))) (was-coding-system buffer-file-coding-system)) (when (not was-encrypted) @@ -6156,8 +5976,7 @@ See `allout-toggle-current-subtree-encryption' for more details." (setq result-text (allout-encrypt-string subject-text was-encrypted - (current-buffer) - for-key-type for-key-identity fetch-pass)) + (current-buffer) keymode-cue)) ;; Replace the subtree with the processed product. (allout-unprotected @@ -6188,335 +6007,173 @@ See `allout-toggle-current-subtree-encryption' for more details." (insert "*")))) (run-hook-with-args 'allout-structure-added-hook bullet-pos subtree-end)))) -;;;_ > allout-encrypt-string (text decrypt allout-buffer key-type for-key -;;; fetch-pass &optional retried verifying -;;; passphrase) -(defun allout-encrypt-string (text decrypt allout-buffer key-type for-key - fetch-pass &optional retried rejected - verifying passphrase) +;;;_ > allout-encrypt-string (text decrypt allout-buffer keymode-cue +;;; &optional rejected) +(defun allout-encrypt-string (text decrypt allout-buffer keymode-cue + &optional rejected) "Encrypt or decrypt message TEXT. -If DECRYPT is true (default false), then decrypt instead of encrypt. +Returns the resulting string, or nil if the transformation fails. -FETCH-PASS (default false) forces fresh prompting for the passphrase. +If DECRYPT is true (default false), then decrypt instead of encrypt. -KEY-TYPE, either `symmetric' or `keypair', specifies which type -of cypher to use. +ALLOUT-BUFFER identifies the buffer containing the text. -FOR-KEY is human readable identification of the first of the user's -eligible secret keys a keypair decryption targets, or else nil. +Entry encryption defaults to symmetric key mode unless keypair +recipients are associated with the file \(see +`epa-file-encrypt-to') or the function is invoked with a +\(KEYMODE-CUE) universal argument greater than 1. -Optional RETRIED is for internal use -- conveys the number of failed keys -that have been solicited in sequence leading to this current call. +When encrypting, KEYMODE-CUE universal argument greater than 1 +causes prompting for recipients for public-key keypair +encryption. Selecting no recipients results in symmetric key +encryption. -Optional PASSPHRASE enables explicit delivery of the decryption passphrase, -for verification purposes. +Further, encrypting with a KEYMODE-CUE universal argument greater +than 4 - eg, preceded by a doubled Ctrl-U - causes association of +the specified recipients with the file, replacing those currently +associated with it. This can be used to deassociate any +recipients with the file, by selecting no recipients in the +dialog. -Optional REJECTED is for internal use -- conveys the number of +Optional REJECTED is for internal use, to convey the number of rejections due to matches against `allout-encryption-ciphertext-rejection-regexps', as limited by `allout-encryption-ciphertext-rejection-ceiling'. -Returns the resulting string, or nil if the transformation fails." - - (require 'pgg) - - (if (not (fboundp 'pgg-encrypt-symmetric)) - (error "Allout encryption depends on a newer version of pgg")) - - (let* ((scheme (upcase - (format "%s" (or pgg-scheme pgg-default-scheme "GPG")))) - (for-key (and (equal key-type 'keypair) - (or for-key - (split-string (read-string - (format "%s message recipients: " - scheme)) - "[ \t,]+")))) - (target-prompt-id (if (equal key-type 'keypair) - (if (= (length for-key) 1) - (car for-key) for-key) - (buffer-name allout-buffer))) - (target-cache-id (format "%s-%s" - key-type - (if (equal key-type 'keypair) - target-prompt-id - (or (buffer-file-name allout-buffer) - target-prompt-id)))) +NOTE: A few GnuPG v2 versions improperly preserve incorrect +symmetric decryption keys, preventing entry of the correct key on +subsequent decryption attempts until the cache times-out. That +can take several minutes. \(Decryption of other entries is not +affected.) Upgrade your EasyPG version, if you can, and you can +deliberately clear your gpg-agent's cache by sending it a '-HUP' +signal." + + (require 'epg) + (require 'epa) + + (let* ((epg-context (let* ((context (epg-make-context nil t))) + (epg-context-set-passphrase-callback + context #'epa-passphrase-callback-function) + context)) (encoding (with-current-buffer allout-buffer buffer-file-coding-system)) (multibyte (with-current-buffer allout-buffer - enable-multibyte-characters)) - (strip-plaintext-regexps - (if (not decrypt) - (allout-get-configvar-values - 'allout-encryption-plaintext-sanitization-regexps))) - (reject-ciphertext-regexps - (if (not decrypt) - (allout-get-configvar-values - 'allout-encryption-ciphertext-rejection-regexps))) + enable-multibyte-characters)) + ;; "sanitization" avoids encryption results that are outline structure. + (sani-regexps 'allout-encryption-plaintext-sanitization-regexps) + (strip-plaintext-regexps (if (not decrypt) + (allout-get-configvar-values + sani-regexps))) + (rejection-regexps 'allout-encryption-ciphertext-rejection-regexps) + (reject-ciphertext-regexps (if (not decrypt) + (allout-get-configvar-values + rejection-regexps))) (rejected (or rejected 0)) (rejections-left (- allout-encryption-ciphertext-rejection-ceiling rejected)) - result-text status + (keypair-mode (cond (decrypt 'decrypting) + ((<= (prefix-numeric-value keymode-cue) 1) + 'default) + ((<= (prefix-numeric-value keymode-cue) 4) + 'prompt) + ((> (prefix-numeric-value keymode-cue) 4) + 'prompt-save))) + (keypair-message (concat "Select encryption recipients.\n" + "Symmetric encryption is done if no" + " recipients are selected. ")) + (encrypt-to (and (boundp 'epa-file-encrypt-to) epa-file-encrypt-to)) + recipients + massaged-text + result-text ) - (if (and fetch-pass (not passphrase)) - ;; Force later fetch by evicting passphrase from the cache. - (pgg-remove-passphrase-from-cache target-cache-id t)) - - (catch 'encryption-failed - - ;; We handle only symmetric-key passphrase caching. - (if (and (not passphrase) - (not (equal key-type 'keypair))) - (setq passphrase (allout-obtain-passphrase for-key - target-cache-id - target-prompt-id - key-type - allout-buffer - retried fetch-pass))) - - (with-temp-buffer - - (insert text) - - ;; convey the text characteristics of the original buffer: - (allout-set-buffer-multibyte multibyte) - (when encoding - (set-buffer-file-coding-system encoding) - (if (not decrypt) - (encode-coding-region (point-min) (point-max) encoding))) - - (when (and strip-plaintext-regexps (not decrypt)) - (dolist (re strip-plaintext-regexps) - (let ((re (if (listp re) (car re) re)) - (replacement (if (listp re) (cadr re) ""))) - (goto-char (point-min)) - (save-match-data - (while (re-search-forward re nil t) - (replace-match replacement nil nil)))))) - - (cond - - ;; symmetric: - ((equal key-type 'symmetric) - (setq status - (if decrypt - - (pgg-decrypt (point-min) (point-max) passphrase) - - (pgg-encrypt-symmetric (point-min) (point-max) - passphrase))) - - (if status - (pgg-situate-output (point-min) (point-max)) - ;; failed -- handle passphrase caching - (if verifying - (throw 'encryption-failed nil) - (pgg-remove-passphrase-from-cache target-cache-id t) - (error "Symmetric-cipher %scryption failed -- %s" - (if decrypt "de" "en") - "try again with different passphrase")))) - - ;; encrypt `keypair': - ((not decrypt) - - (setq status - - (pgg-encrypt for-key - nil (point-min) (point-max) passphrase)) - - (if status - (pgg-situate-output (point-min) (point-max)) - (error (pgg-remove-passphrase-from-cache target-cache-id t) - (error "encryption failed")))) - - ;; decrypt `keypair': - (t - - (setq status - (pgg-decrypt (point-min) (point-max) passphrase)) - - (if status - (pgg-situate-output (point-min) (point-max)) - (error (pgg-remove-passphrase-from-cache target-cache-id t) - (error "decryption failed"))))) - - (setq result-text - (buffer-substring-no-properties - 1 (- (point-max) (if decrypt 0 1)))) - ) - - ;; validate result -- non-empty - (cond ((not result-text) - (if verifying - nil - ;; transform was fruitless, retry w/new passphrase. - (pgg-remove-passphrase-from-cache target-cache-id t) - (allout-encrypt-string text decrypt allout-buffer - key-type for-key nil - (if retried (1+ retried) 1) - rejected verifying nil))) - - ;; Retry (within limit) if ciphertext contains rejections: - ((and (not decrypt) - ;; Check for disqualification of this ciphertext: - (let ((regexps reject-ciphertext-regexps) - reject-it) - (while (and regexps (not reject-it)) - (setq reject-it (string-match (car regexps) - result-text)) - (pop regexps)) - reject-it)) - (setq rejections-left (1- rejections-left)) - (if (<= rejections-left 0) - (error (concat "Ciphertext rejected too many times" - " (%s), per `%s'") - allout-encryption-ciphertext-rejection-ceiling - 'allout-encryption-ciphertext-rejection-regexps) - (allout-encrypt-string text decrypt allout-buffer - key-type for-key nil - retried (1+ rejected) - verifying passphrase))) - ;; Barf if encryption yields extraordinary control chars: - ((and (not decrypt) - (string-match "[\C-a\C-k\C-o-\C-z\C-@]" - result-text)) - (error (concat "Encryption produced non-armored text, which" - "conflicts with allout mode -- reconfigure!"))) - - ;; valid result and just verifying or non-symmetric: - ((or verifying (not (equal key-type 'symmetric))) - (if (or verifying decrypt) - (pgg-add-passphrase-to-cache target-cache-id - passphrase t)) - result-text) - - ;; valid result and regular symmetric -- "register" - ;; passphrase with mnemonic aids/cache. - (t - (set-buffer allout-buffer) - (if passphrase - (pgg-add-passphrase-to-cache target-cache-id - passphrase t)) - (allout-update-passphrase-mnemonic-aids for-key passphrase - allout-buffer) - result-text) - ) - ) - ) - ) -;;;_ > allout-obtain-passphrase (for-key cache-id prompt-id key-type -;;; allout-buffer retried fetch-pass) -(defun allout-obtain-passphrase (for-key cache-id prompt-id key-type - allout-buffer retried fetch-pass) - "Obtain passphrase for a key from the cache or else from the user. - -When obtaining from the user, symmetric-cipher passphrases are verified -against either, if available and enabled, a random string that was -encrypted against the passphrase, or else against repeated entry by the -user for corroboration. - -FOR-KEY is the key for which the passphrase is being obtained. - -CACHE-ID is the cache id of the key for the passphrase. - -PROMPT-ID is the id for use when prompting the user. - -KEY-TYPE is either `symmetric' or `keypair'. - -ALLOUT-BUFFER is the buffer containing the entry being en/decrypted. - -RETRIED is the number of this attempt to obtain this passphrase. - -FETCH-PASS causes the passphrase to be solicited from the user, regardless -of the availability of a cached copy." - - (if (not (equal key-type 'symmetric)) - ;; do regular passphrase read on non-symmetric passphrase: - (pgg-read-passphrase (format "%s passphrase%s: " - (upcase (format "%s" (or pgg-scheme - pgg-default-scheme - "GPG"))) - (if prompt-id - (format " for %s" prompt-id) - "")) - cache-id t) - - ;; Symmetric hereon: - - (with-current-buffer allout-buffer - (let* ((hint (if (and (not (string= allout-passphrase-hint-string "")) - (or (equal allout-passphrase-hint-handling 'always) - (and (equal allout-passphrase-hint-handling - 'needed) - retried))) - (format " [%s]" allout-passphrase-hint-string) - "")) - (retry-message (if retried (format " (%s retry)" retried) "")) - (prompt-sans-hint (format "'%s' symmetric passphrase%s: " - prompt-id retry-message)) - (full-prompt (format "'%s' symmetric passphrase%s%s: " - prompt-id hint retry-message)) - (prompt full-prompt) - (verifier-string (allout-get-encryption-passphrase-verifier)) - - (cached (and (not fetch-pass) - (pgg-read-passphrase-from-cache cache-id t))) - (got-pass (or cached - (pgg-read-passphrase full-prompt cache-id t))) - confirmation) - - (if (not got-pass) - nil + ;; Massage the subject text for encoding and filtering. + (with-temp-buffer + (insert text) + ;; convey the text characteristics of the original buffer: + (allout-set-buffer-multibyte multibyte) + (when encoding + (set-buffer-file-coding-system encoding) + (if (not decrypt) + (encode-coding-region (point-min) (point-max) encoding))) + + ;; remove sanitization regexps matches before encrypting: + (when (and strip-plaintext-regexps (not decrypt)) + (dolist (re strip-plaintext-regexps) + (let ((re (if (listp re) (car re) re)) + (replacement (if (listp re) (cadr re) ""))) + (goto-char (point-min)) + (save-match-data + (while (re-search-forward re nil t) + (replace-match replacement nil nil)))))) + (setq massaged-text (buffer-substring-no-properties (point-min) + (point-max)))) + ;; determine key mode and, if keypair, recipients: + (setq recipients + (case keypair-mode + + (decrypting nil) + + (default (if encrypt-to (epg-list-keys epg-context encrypt-to))) + + ((prompt prompt-save) + (save-window-excursion + (epa-select-keys epg-context keypair-message))))) + + (setq result-text + (if decrypt + (epg-decrypt-string epg-context + (encode-coding-string massaged-text + (or encoding 'utf-8))) + (replace-regexp-in-string "\n$" "" + (epg-encrypt-string epg-context + (encode-coding-string massaged-text + (or encoding 'utf-8)) + recipients)))) + + ;; validate result -- non-empty + (if (not result-text) + (error "%scryption failed." (if decrypt "De" "En"))) + + + (when (eq keypair-mode 'prompt-save) + ;; set epa-file-encrypt-to in the buffer: + (setq epa-file-encrypt-to (mapcar (lambda (key) + (epg-user-id-string + (car (epg-key-user-id-list key)))) + recipients)) + ;; change the file variable: + (allout-adjust-file-variable "epa-file-encrypt-to" epa-file-encrypt-to)) - ;; Duplicate our handle on the passphrase so it's not clobbered by - ;; deactivate-passwd memory clearing: - (setq got-pass (copy-sequence got-pass)) - - (cond (verifier-string - (save-window-excursion - (if (allout-encrypt-string verifier-string 'decrypt - allout-buffer 'symmetric - for-key nil 0 0 'verifying - (copy-sequence got-pass)) - (setq confirmation (format "%s" got-pass)))) - - (if (and (not confirmation) - (if (yes-or-no-p - (concat "Passphrase differs from established" - " -- use new one instead? ")) - ;; deactivate password for subsequent - ;; confirmation: - (progn - (pgg-remove-passphrase-from-cache cache-id t) - (setq prompt prompt-sans-hint) - nil) - t)) - (progn (pgg-remove-passphrase-from-cache cache-id t) - (error "Wrong passphrase")))) - ;; No verifier string -- force confirmation by repetition of - ;; (new) passphrase: - ((or fetch-pass (not cached)) - (pgg-remove-passphrase-from-cache cache-id t)))) - ;; confirmation vs new input -- doing pgg-read-passphrase will do the - ;; right thing, in either case: - (if (not confirmation) - (setq confirmation - (pgg-read-passphrase (concat prompt - " ... confirm spelling: ") - cache-id t))) - (prog1 - (if (equal got-pass confirmation) - confirmation - (if (yes-or-no-p (concat "spelling of original and" - " confirmation differ -- retry? ")) - (progn (setq retried (if retried (1+ retried) 1)) - (pgg-remove-passphrase-from-cache cache-id t) - ;; recurse to this routine: - (pgg-read-passphrase prompt-sans-hint cache-id t)) - (pgg-remove-passphrase-from-cache cache-id t) - (error "Confirmation failed")))))))) + (cond + ;; Retry (within limit) if ciphertext contains rejections: + ((and (not decrypt) + ;; Check for disqualification of this ciphertext: + (let ((regexps reject-ciphertext-regexps) + reject-it) + (while (and regexps (not reject-it)) + (setq reject-it (string-match (car regexps) result-text)) + (pop regexps)) + reject-it)) + (setq rejections-left (1- rejections-left)) + (if (<= rejections-left 0) + (error (concat "Ciphertext rejected too many times" + " (%s), per `%s'") + allout-encryption-ciphertext-rejection-ceiling + 'allout-encryption-ciphertext-rejection-regexps) + ;; try again (gpg-agent may have the key cached): + (allout-encrypt-string text decrypt allout-buffer keypair-mode + (1+ rejected)))) + + ;; Barf if encryption yields extraordinary control chars: + ((and (not decrypt) + (string-match "[\C-a\C-k\C-o-\C-z\C-@]" + result-text)) + (error (concat "Encryption produced non-armored text, which" + "conflicts with allout mode -- reconfigure!"))) + + (t result-text)))) ;;;_ > allout-encrypted-topic-p () (defun allout-encrypted-topic-p () "True if the current topic is encryptable and encrypted." @@ -6527,128 +6184,6 @@ of the availability of a cached copy." (save-match-data (looking-at "\\*"))) ) ) -;;;_ > allout-encrypted-key-info (text) -;; XXX gpg-specific, alas -(defun allout-encrypted-key-info (text) - "Return a pair of the key type and identity of a recipient's secret key. - -The key type is one of `symmetric' or `keypair'. - -If `keypair', and some of the user's secret keys are among those for which -the message was encoded, return the identity of the first. Otherwise, -return nil for the second item of the pair. - -An error is raised if the text is not encrypted." - (require 'pgg-parse) - (save-excursion - (with-temp-buffer - (insert text) - (let* ((parsed-armor (pgg-parse-armor-region (point-min) (point-max))) - (type (if (pgg-gpg-symmetric-key-p parsed-armor) - 'symmetric - 'keypair)) - secret-keys first-secret-key for-key-owner) - (if (equal type 'keypair) - (setq secret-keys (pgg-gpg-lookup-all-secret-keys) - first-secret-key (pgg-gpg-select-matching-key parsed-armor - secret-keys) - for-key-owner (and first-secret-key - (pgg-gpg-lookup-key-owner - first-secret-key)))) - (list type (pgg-gpg-key-id-from-key-owner for-key-owner)) - ) - ) - ) - ) -;;;_ > allout-create-encryption-passphrase-verifier (passphrase) -(defun allout-create-encryption-passphrase-verifier (passphrase) - "Encrypt random message for later validation of symmetric key's passphrase." - ;; use 20 random ascii characters, across the entire ascii range. - (random t) - (let ((spew (make-string 20 ?\0))) - (dotimes (i (length spew)) - (aset spew i (1+ (random 254)))) - (allout-encrypt-string spew nil (current-buffer) 'symmetric - nil nil 0 0 passphrase)) - ) -;;;_ > allout-update-passphrase-mnemonic-aids (for-key passphrase -;;; outline-buffer) -(defun allout-update-passphrase-mnemonic-aids (for-key passphrase - outline-buffer) - "Update passphrase verifier and hint strings if necessary. - -See `allout-passphrase-verifier-string' and `allout-passphrase-hint-string' -settings. - -PASSPHRASE is the passphrase being mnemonicized. - -OUTLINE-BUFFER is the buffer of the outline being adjusted. - -These are used to help the user keep track of the passphrase they use for -symmetric encryption in the file. - -Behavior is governed by `allout-passphrase-verifier-handling', -`allout-passphrase-hint-handling', and also, controlling whether the values -are preserved on Emacs local file variables, -`allout-enable-file-variable-adjustment'." - - ;; If passphrase doesn't agree with current verifier: - ;; - adjust the verifier - ;; - if passphrase hint handling is enabled, adjust the passphrase hint - ;; - if file var settings are enabled, adjust the file vars - - (let* ((new-verifier-needed (not (allout-verify-passphrase - for-key passphrase outline-buffer))) - (new-verifier-string - (if new-verifier-needed - ;; Collapse to a single line and enclose in string quotes: - (subst-char-in-string - ?\n ?\C-a (allout-create-encryption-passphrase-verifier - passphrase)))) - new-hint) - (when new-verifier-string - ;; do the passphrase hint first, since it's interactive - (when (and allout-passphrase-hint-handling - (not (equal allout-passphrase-hint-handling 'disabled))) - (setq new-hint - (read-from-minibuffer "Passphrase hint to jog your memory: " - allout-passphrase-hint-string)) - (when (not (string= new-hint allout-passphrase-hint-string)) - (setq allout-passphrase-hint-string new-hint) - (allout-adjust-file-variable "allout-passphrase-hint-string" - allout-passphrase-hint-string))) - (when allout-passphrase-verifier-handling - (setq allout-passphrase-verifier-string new-verifier-string) - (allout-adjust-file-variable "allout-passphrase-verifier-string" - allout-passphrase-verifier-string)) - ) - ) - ) -;;;_ > allout-get-encryption-passphrase-verifier () -(defun allout-get-encryption-passphrase-verifier () - "Return text of the encrypt passphrase verifier, unmassaged, or nil if none. - -Derived from value of `allout-passphrase-verifier-string'." - - (let ((verifier-string (and (boundp 'allout-passphrase-verifier-string) - allout-passphrase-verifier-string))) - (if verifier-string - ;; Return it uncollapsed - (subst-char-in-string ?\C-a ?\n verifier-string)) - ) - ) -;;;_ > allout-verify-passphrase (key passphrase allout-buffer) -(defun allout-verify-passphrase (key passphrase allout-buffer) - "True if passphrase successfully decrypts verifier, nil otherwise. - -\"Otherwise\" includes absence of passphrase verifier." - (with-current-buffer allout-buffer - (and (boundp 'allout-passphrase-verifier-string) - allout-passphrase-verifier-string - (allout-encrypt-string (allout-get-encryption-passphrase-verifier) - 'decrypt allout-buffer 'symmetric - key nil 0 0 'verifying passphrase) - t))) ;;;_ > allout-next-topic-pending-encryption (&optional except-mark) (defun allout-next-topic-pending-encryption (&optional except-mark) "Return the point of the next topic pending encryption, or nil if none. @@ -6772,7 +6307,8 @@ setup for auto-startup." (interactive "P") - (allout-mode t) + (if (allout-mode-p) (allout-mode)) ; deactivate so we can re-activate... + (allout-mode) (save-excursion (goto-char (point-min)) @@ -7176,13 +6712,13 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." ;; No docstring because xemacs defalias doesn't support it. ) ;;;_ > allout-set-buffer-multibyte -;; define as alias first, so byte compiler is happy. -(defalias 'allout-set-buffer-multibyte 'set-buffer-multibyte) -;; then supplant with definition if underlying alias absent. -(if (not (fboundp 'set-buffer-multibyte)) - (defun allout-set-buffer-multibyte (is-multibyte) - (setq enable-multibyte-characters is-multibyte)) - ) +(if (fboundp 'set-buffer-multibyte) + (defalias 'allout-set-buffer-multibyte 'set-buffer-multibyte) + (with-no-warnings + ;; this definition is used only in older or alternative emacs, where + ;; the setting is our only recourse. + (defun allout-set-buffer-multibyte (is-multibyte) + (set enable-multibyte-characters is-multibyte)))) ;;;_ > allout-select-safe-coding-system (defalias 'allout-select-safe-coding-system (if (fboundp 'select-safe-coding-system) |