6 |
;; Author: Ken Manheimer <ken dot manheimer at gmail dot com> |
;; Author: Ken Manheimer <ken dot manheimer at gmail dot com> |
7 |
;; Maintainer: Ken Manheimer <ken dot manheimer at gmail dot com> |
;; Maintainer: Ken Manheimer <ken dot manheimer at gmail dot com> |
8 |
;; Created: Dec 1991 - first release to usenet |
;; Created: Dec 1991 - first release to usenet |
9 |
|
;; Version: 2.1 |
10 |
;; Keywords: outlines wp languages |
;; Keywords: outlines wp languages |
11 |
|
|
12 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
46 |
;; formatted as an outline - do ESC-x eval-current-buffer in allout.el |
;; formatted as an outline - do ESC-x eval-current-buffer in allout.el |
47 |
;; to try it out.) |
;; to try it out.) |
48 |
;; - configurable per-file initial exposure settings |
;; - configurable per-file initial exposure settings |
49 |
;; - symmetric-key and key-pair topic encryption, plus reliable key |
;; - symmetric-key and key-pair topic encryption, plus symmetric passphrase |
50 |
;; verification and user-supplied hint maintenance. (see |
;; mnemonic support, with verification against an established passphrase |
51 |
;; allout-toggle-current-subtree-encryption docstring.) |
;; (using a stashed encrypted dummy string) and user-supplied hint |
52 |
|
;; maintenance. (see allout-toggle-current-subtree-encryption docstring.) |
53 |
;; - automatic topic-number maintenance |
;; - automatic topic-number maintenance |
54 |
;; - "hot-spot" operation, for single-keystroke maneuvering and |
;; - "hot-spot" operation, for single-keystroke maneuvering and |
55 |
;; exposure control (see the allout-mode docstring) |
;; exposure control (see the allout-mode docstring) |
81 |
|
|
82 |
;;;_* Dependency autoloads |
;;;_* Dependency autoloads |
83 |
(eval-when-compile 'cl) ; otherwise, flet compilation fouls |
(eval-when-compile 'cl) ; otherwise, flet compilation fouls |
84 |
(autoload 'crypt-encrypt-buffer "crypt++") |
(eval-when-compile (progn (require 'pgg) |
85 |
(setq-default crypt-encryption-type 'gpg) |
(require 'pgg-gpg))) |
86 |
|
(autoload 'pgg-gpg-symmetric-key-p "pgg-gpg" |
87 |
(autoload 'mc-encrypt "mailcrypt" |
"True if decoded armor MESSAGE-KEYS has symmetric encryption indicator.") |
|
"*Encrypt the current buffer") |
|
|
(autoload 'mc-activate-passwd "mailcrypt" |
|
|
"Activate the passphrase matching ID, using PROMPT for a prompt. |
|
|
Return the passphrase. If PROMPT is nil, only return value if cached.") |
|
|
(autoload 'mc-gpg-process-region "mc-gpg") |
|
|
(autoload 'mc-dectivate-passwd "mailcrypt" |
|
|
"*Deactivate the passphrase cache.") |
|
88 |
|
|
89 |
;;;_* USER CUSTOMIZATION VARIABLES: |
;;;_* USER CUSTOMIZATION VARIABLES: |
90 |
(defgroup allout nil |
(defgroup allout nil |
423 |
"*Bullet signifying encryption of the entry's body." |
"*Bullet signifying encryption of the entry's body." |
424 |
:type '(choice (const nil) string) |
:type '(choice (const nil) string) |
425 |
:group 'allout) |
:group 'allout) |
426 |
;;;_ = allout-default-encryption-scheme |
;;;_ = allout-passphrase-verifier-handling |
427 |
(defcustom allout-default-encryption-scheme 'mc-scheme-gpg |
(defcustom allout-passphrase-verifier-handling t |
428 |
"*Default allout outline topic encryption mode. |
"*Enable use of symmetric encryption passphrase verifier if non-nil. |
|
|
|
|
See mailcrypt variable `mc-schemes' and mailcrypt docs for encryption schemes." |
|
|
:type 'symbol |
|
|
:group 'allout) |
|
|
;;;_ = allout-key-verifier-handling |
|
|
(defcustom allout-key-verifier-handling 'situate |
|
|
"*Dictate outline encryption key verifier handling. |
|
|
|
|
|
The key verifier is string associated with a file that is encrypted with |
|
|
the file's current symmetric encryption key. It is used, if present, to |
|
|
confirm that the key entered by the user is the same as the established |
|
|
one, or explicitly presenting the user with the choice to go with a |
|
|
new key when a difference is encountered. |
|
|
|
|
|
The range of values are: |
|
|
|
|
|
situate - include key verifier string as text in the file's local-vars |
|
|
section |
|
|
transient - establish the value as a variable in the file's buffer, but |
|
|
don't preserve it as a file variable. |
|
|
disabled - don't establish or do verification. |
|
429 |
|
|
430 |
See the docstring for the `allout-enable-file-variable-adjustment' |
See the docstring for the `allout-enable-file-variable-adjustment' |
431 |
variable for details about allout ajustment of file variables." |
variable for details about allout ajustment of file variables." |
432 |
:type '(choice (const situate) |
:type 'boolean |
|
(const transient) |
|
|
(const disabled)) |
|
433 |
:group 'allout) |
:group 'allout) |
434 |
(make-variable-buffer-local 'allout-key-verifier-handling) |
(make-variable-buffer-local 'allout-passphrase-verifier-handling) |
435 |
;;;_ = allout-key-hint-handling |
;;;_ = allout-passphrase-hint-handling |
436 |
(defcustom allout-key-hint-handling 'always |
(defcustom allout-passphrase-hint-handling 'always |
437 |
"*Dictate outline encryption key reminder handling: |
"*Dictate outline encryption passphrase reminder handling: |
438 |
|
|
439 |
always - always show reminder when prompting |
always - always show reminder when prompting |
440 |
needed - show reminder on key entry failure |
needed - show reminder on passphrase entry failure |
441 |
manage - never present reminder, but still manage a file-var entry for it |
disabled - never present or adjust reminder |
|
disabled - don't even manage the file variable entry |
|
442 |
|
|
443 |
See the docstring for the `allout-enable-file-variable-adjustment' |
See the docstring for the `allout-enable-file-variable-adjustment' |
444 |
variable for details about allout ajustment of file variables." |
variable for details about allout ajustment of file variables." |
445 |
:type '(choice (const always) |
:type '(choice (const always) |
446 |
(const needed) |
(const needed) |
|
(const manage) |
|
447 |
(const disabled)) |
(const disabled)) |
448 |
:group 'allout) |
:group 'allout) |
449 |
(make-variable-buffer-local 'allout-key-hint-handling) |
(make-variable-buffer-local 'allout-passphrase-hint-handling) |
450 |
;;;_ = allout-encrypt-unencrypted-on-saves |
;;;_ = allout-encrypt-unencrypted-on-saves |
451 |
(defcustom allout-encrypt-unencrypted-on-saves 'except-current |
(defcustom allout-encrypt-unencrypted-on-saves 'except-current |
452 |
"*When saving, should topics pending encryption be encrypted? |
"*When saving, should topics pending encryption be encrypted? |
464 |
- All except current topic: skip the topic currently being edited, even if |
- All except current topic: skip the topic currently being edited, even if |
465 |
it's pending encryption. This may expose the current topic on the |
it's pending encryption. This may expose the current topic on the |
466 |
file sytem, but avoids the nuisance of prompts for the encryption |
file sytem, but avoids the nuisance of prompts for the encryption |
467 |
key in the middle of editing for, eg, autosaves. |
passphrase in the middle of editing for, eg, autosaves. |
468 |
This mode is used for auto-saves for both this option and \"Yes\". |
This mode is used for auto-saves for both this option and \"Yes\". |
469 |
- No: leave it to the user to encrypt any unencrypted topics. |
- No: leave it to the user to encrypt any unencrypted topics. |
470 |
|
|
471 |
For practical reasons, auto-saves always use the 'except-current policy |
For practical reasons, auto-saves always use the 'except-current policy |
472 |
when auto-encryption is enabled. \(Otherwise, spurious key prompts and |
when auto-encryption is enabled. \(Otherwise, spurious passphrase prompts |
473 |
unavoidable timing collisions are too disruptive.) If security for a file |
and unavoidable timing collisions are too disruptive.) If security for a |
474 |
requires that even the current topic is never auto-saved in the clear, |
file requires that even the current topic is never auto-saved in the clear, |
475 |
disable auto-saves for that file." |
disable auto-saves for that file." |
476 |
|
|
477 |
:type '(choice (const :tag "Yes" t) |
:type '(choice (const :tag "Yes" t) |
576 |
|
|
577 |
;;;_ = allout-enable-file-variable-adjustment |
;;;_ = allout-enable-file-variable-adjustment |
578 |
(defcustom allout-enable-file-variable-adjustment t |
(defcustom allout-enable-file-variable-adjustment t |
579 |
"*If non-nil, some allout outline actions can edit Emacs file variables text. |
"*If non-nil, some allout outline actions edit Emacs local file var text. |
580 |
|
|
581 |
This can range from changes to existing entries, addition of new ones, |
This can range from changes to existing entries, addition of new ones, |
582 |
and creation of a new local variables section when necessary. |
and creation of a new local variables section when necessary. |
596 |
;;;_ #1 Internal Outline Formatting and Configuration |
;;;_ #1 Internal Outline Formatting and Configuration |
597 |
;;;_ : Version |
;;;_ : Version |
598 |
;;;_ = allout-version |
;;;_ = allout-version |
599 |
(defvar allout-version |
(defvar allout-version "2.1" |
600 |
(let ((rcs-rev "$Revision$")) |
"Version of currently loaded outline package. \(allout.el)") |
|
(condition-case err |
|
|
(save-match-data |
|
|
(string-match "Revision: \\([0-9]+\\.[0-9]+\\)" rcs-rev) |
|
|
(substring rcs-rev (match-beginning 1) (match-end 1))) |
|
|
('error rcs-rev))) |
|
|
"Revision number of currently loaded outline package. \(allout.el)") |
|
601 |
;;;_ > allout-version |
;;;_ > allout-version |
602 |
(defun allout-version (&optional here) |
(defun allout-version (&optional here) |
603 |
"Return string describing the loaded outline version." |
"Return string describing the loaded outline version." |
991 |
"Horrible hack used to prevent invalid multiple triggering of outline |
"Horrible hack used to prevent invalid multiple triggering of outline |
992 |
mode from prop-line file-var activation. Used by `allout-mode' function |
mode from prop-line file-var activation. Used by `allout-mode' function |
993 |
to track repeats.") |
to track repeats.") |
994 |
;;;_ = allout-file-key-verifier-string |
;;;_ = allout-file-passphrase-verifier-string |
995 |
(defvar allout-file-key-verifier-string nil |
(defvar allout-file-passphrase-verifier-string nil |
996 |
"Name for use as a file variable for verifying encryption key across |
"Name for use as a file variable for verifying encryption passphrase |
997 |
sessions.") |
across sessions.") |
998 |
(make-variable-buffer-local 'allout-file-key-verifier-string) |
(make-variable-buffer-local 'allout-file-passphrase-verifier-string) |
999 |
;;;_ = allout-encryption-scheme |
;;;_ = allout-passphrase-verifier-string |
1000 |
(defvar allout-encryption-scheme nil |
(defvar allout-passphrase-verifier-string nil |
1001 |
"*Allout outline topic encryption scheme pending for the current buffer. |
"Setting used to test solicited encryption passphrases against the one |
1002 |
|
already associated with a file. |
1003 |
Intended as a file-specific (buffer local) setting, it defaults to the |
|
1004 |
value of allout-default-encryption-scheme if nil.") |
It consists of an encrypted random string useful only to verify that a |
1005 |
(make-variable-buffer-local 'allout-encryption-scheme) |
passphrase entered by the user is effective for decryption. The passphrase |
1006 |
;;;_ = allout-key-verifier-string |
itself is \*not* recorded in the file anywhere, and the encrypted contents |
1007 |
(defvar allout-key-verifier-string nil |
are random binary characters to avoid exposing greater susceptibility to |
1008 |
"Setting used to test solicited encryption keys against that already |
search attacks. |
|
associated with a file. |
|
|
|
|
|
It consists of an encrypted random string useful only to verify that a key |
|
|
entered by the user is effective for decryption. The key itself is \*not* |
|
|
recorded in the file anywhere, and the encrypted contents are random binary |
|
|
characters to avoid exposing greater susceptibility to search attacks. |
|
1009 |
|
|
1010 |
The verifier string is retained as an Emacs file variable, as well as in |
The verifier string is retained as an Emacs file variable, as well as in |
1011 |
the emacs buffer state, if file variable adjustments are enabled. See |
the emacs buffer state, if file variable adjustments are enabled. See |
1012 |
`allout-enable-file-variable-adjustment' for details about that.") |
`allout-enable-file-variable-adjustment' for details about that.") |
1013 |
(make-variable-buffer-local 'allout-key-verifier-string) |
(make-variable-buffer-local 'allout-passphrase-verifier-string) |
1014 |
(setq-default allout-key-verifier-string nil) |
;;;_ = allout-passphrase-hint-string |
1015 |
;;;_ = allout-key-hint-string |
(defvar allout-passphrase-hint-string "" |
1016 |
(defvar allout-key-hint-string "" |
"Variable used to retain reminder string for file's encryption passphrase. |
|
"Variable used to retain a reminder string for a file's encryption key. |
|
1017 |
|
|
1018 |
See the description of `allout-key-hint-handling' for details about how |
See the description of `allout-passphrase-hint-handling' for details about how |
1019 |
the reminder is deployed. |
the reminder is deployed. |
1020 |
|
|
1021 |
The hint is retained as an Emacs file variable, as well as in the emacs buffer |
The hint is retained as an Emacs file variable, as well as in the emacs buffer |
1022 |
state, if file variable adjustments are enabled. See |
state, if file variable adjustments are enabled. See |
1023 |
`allout-enable-file-variable-adjustment' for details about that.") |
`allout-enable-file-variable-adjustment' for details about that.") |
1024 |
(make-variable-buffer-local 'allout-key-hint-string) |
(make-variable-buffer-local 'allout-passphrase-hint-string) |
1025 |
(setq-default allout-key-hint-string "") |
(setq-default allout-passphrase-hint-string "") |
1026 |
;;;_ = allout-after-save-decrypt |
;;;_ = allout-after-save-decrypt |
1027 |
(defvar allout-after-save-decrypt nil |
(defvar allout-after-save-decrypt nil |
1028 |
"Internal variable, is nil or has the value of two points: |
"Internal variable, is nil or has the value of two points: |
1037 |
(defun allout-write-file-hook-handler () |
(defun allout-write-file-hook-handler () |
1038 |
"Implement `allout-encrypt-unencrypted-on-saves' policy for file writes." |
"Implement `allout-encrypt-unencrypted-on-saves' policy for file writes." |
1039 |
|
|
1040 |
(if (or (not (boundp 'allout-encrypt-unencrypted-on-saves)) |
(if (or (not (allout-mode-p)) |
1041 |
|
(not (boundp 'allout-encrypt-unencrypted-on-saves)) |
1042 |
(not allout-encrypt-unencrypted-on-saves)) |
(not allout-encrypt-unencrypted-on-saves)) |
1043 |
nil |
nil |
1044 |
(let ((except-mark (and (equal allout-encrypt-unencrypted-on-saves |
(let ((except-mark (and (equal allout-encrypt-unencrypted-on-saves |
1063 |
(defun allout-auto-save-hook-handler () |
(defun allout-auto-save-hook-handler () |
1064 |
"Implement `allout-encrypt-unencrypted-on-saves' policy for auto saves." |
"Implement `allout-encrypt-unencrypted-on-saves' policy for auto saves." |
1065 |
|
|
1066 |
(if allout-encrypt-unencrypted-on-saves |
(if (and (allout-mode-p) allout-encrypt-unencrypted-on-saves) |
1067 |
;; Always implement 'except-current policy when enabled. |
;; Always implement 'except-current policy when enabled. |
1068 |
(let ((allout-encrypt-unencrypted-on-saves 'except-current)) |
(let ((allout-encrypt-unencrypted-on-saves 'except-current)) |
1069 |
(allout-write-file-hook-handler)))) |
(allout-write-file-hook-handler)))) |
1148 |
(let |
(let |
1149 |
;; convenience aliases, for consistent ref to respective vars: |
;; convenience aliases, for consistent ref to respective vars: |
1150 |
((hook 'allout-find-file-hook) |
((hook 'allout-find-file-hook) |
1151 |
|
(find-file-hook-var-name (if (boundp 'find-file-hook) |
1152 |
|
'find-file-hook |
1153 |
|
'find-file-hooks)) |
1154 |
(curr-mode 'allout-auto-activation)) |
(curr-mode 'allout-auto-activation)) |
1155 |
|
|
1156 |
(cond ((not mode) |
(cond ((not mode) |
1157 |
(setq find-file-hooks (delq hook find-file-hooks)) |
(set find-file-hook-var-name |
1158 |
|
(delq hook (symbol-value find-file-hook-var-name))) |
1159 |
(if (interactive-p) |
(if (interactive-p) |
1160 |
(message "Allout outline mode auto-activation inhibited."))) |
(message "Allout outline mode auto-activation inhibited."))) |
1161 |
((eq mode 'report) |
((eq mode 'report) |
1162 |
(if (not (memq hook find-file-hooks)) |
(if (not (memq hook (symbol-value find-file-hook-var-name))) |
1163 |
(allout-init nil) |
(allout-init nil) |
1164 |
;; Just punt and use the reports from each of the modes: |
;; Just punt and use the reports from each of the modes: |
1165 |
(allout-init (symbol-value curr-mode)))) |
(allout-init (symbol-value curr-mode)))) |
1166 |
(t (add-hook 'find-file-hooks hook) |
(t (add-hook find-file-hook-var-name hook) |
1167 |
(set curr-mode ; `set', not `setq'! |
(set curr-mode ; `set', not `setq'! |
1168 |
(cond ((eq mode 'activate) |
(cond ((eq mode 'activate) |
1169 |
(message |
(message |
1195 |
(easy-menu-add cur)))) |
(easy-menu-add cur)))) |
1196 |
;;;_ > allout-mode (&optional toggle) |
;;;_ > allout-mode (&optional toggle) |
1197 |
;;;_ : Defun: |
;;;_ : Defun: |
1198 |
|
;;;###autoload |
1199 |
(defun allout-mode (&optional toggle) |
(defun allout-mode (&optional toggle) |
1200 |
;;;_ . Doc string: |
;;;_ . Doc string: |
1201 |
"Toggle minor mode for controlling exposure and editing of text outlines. |
"Toggle minor mode for controlling exposure and editing of text outlines. |
1234 |
|
|
1235 |
Navigation: Exposure Control: |
Navigation: Exposure Control: |
1236 |
---------- ---------------- |
---------- ---------------- |
1237 |
C-c C-n allout-next-visible-heading | C-c C-h allout-hide-current-subtree |
\\[allout-next-visible-heading] allout-next-visible-heading | \\[allout-hide-current-subtree] allout-hide-current-subtree |
1238 |
C-c C-p allout-previous-visible-heading | C-c C-i allout-show-children |
\\[allout-previous-visible-heading] allout-previous-visible-heading | \\[allout-show-children] allout-show-children |
1239 |
C-c C-u allout-up-current-level | C-c C-s allout-show-current-subtree |
\\[allout-up-current-level] allout-up-current-level | \\[allout-show-current-subtree] allout-show-current-subtree |
1240 |
C-c C-f allout-forward-current-level | C-c C-o allout-show-current-entry |
\\[allout-forward-current-level] allout-forward-current-level | \\[allout-show-current-entry] allout-show-current-entry |
1241 |
C-c C-b allout-backward-current-level | ^U C-c C-s allout-show-all |
\\[allout-backward-current-level] allout-backward-current-level | \\[allout-show-all] allout-show-all |
1242 |
C-c C-e allout-end-of-entry | allout-hide-current-leaves |
\\[allout-end-of-entry] allout-end-of-entry |
1243 |
C-c C-a allout-beginning-of-current-entry, alternately, goes to hot-spot |
\\[allout-beginning-of-current-entry,] allout-beginning-of-current-entry, alternately, goes to hot-spot |
1244 |
|
|
1245 |
Topic Header Production: |
Topic Header Production: |
1246 |
----------------------- |
----------------------- |
1247 |
C-c<SP> allout-open-sibtopic Create a new sibling after current topic. |
\\[allout-open-sibtopic] allout-open-sibtopic Create a new sibling after current topic. |
1248 |
C-c . allout-open-subtopic ... an offspring of current topic. |
\\[allout-open-subtopic] allout-open-subtopic ... an offspring of current topic. |
1249 |
C-c , allout-open-supertopic ... a sibling of the current topic's parent. |
\\[allout-open-supertopic] allout-open-supertopic ... a sibling of the current topic's parent. |
1250 |
|
|
1251 |
Topic Level and Prefix Adjustment: |
Topic Level and Prefix Adjustment: |
1252 |
--------------------------------- |
--------------------------------- |
1253 |
C-c > allout-shift-in Shift current topic and all offspring deeper. |
\\[allout-shift-in] allout-shift-in Shift current topic and all offspring deeper. |
1254 |
C-c < allout-shift-out ... less deep. |
\\[allout-shift-out] allout-shift-out ... less deep. |
1255 |
C-c<CR> allout-rebullet-topic Reconcile bullets of topic and its offspring |
\\[allout-rebullet-current-heading] allout-rebullet-current-heading Prompt for alternate bullet for |
1256 |
|
current topic. |
1257 |
|
\\[allout-rebullet-topic] allout-rebullet-topic Reconcile bullets of topic and its offspring |
1258 |
- distinctive bullets are not changed, others |
- distinctive bullets are not changed, others |
1259 |
alternated according to nesting depth. |
alternated according to nesting depth. |
1260 |
C-c b allout-rebullet-current-heading Prompt for alternate bullet for |
\\[allout-number-siblings] allout-number-siblings Number bullets of topic and siblings - the |
|
current topic. |
|
|
C-c # allout-number-siblings Number bullets of topic and siblings - the |
|
1261 |
offspring are not affected. With repeat |
offspring are not affected. With repeat |
1262 |
count, revoke numbering. |
count, revoke numbering. |
1263 |
|
|
1264 |
Topic-oriented Killing and Yanking: |
Topic-oriented Killing and Yanking: |
1265 |
---------------------------------- |
---------------------------------- |
1266 |
C-c C-k allout-kill-topic Kill current topic, including offspring. |
\\[allout-kill-topic] allout-kill-topic Kill current topic, including offspring. |
1267 |
C-k allout-kill-line Like kill-line, but reconciles numbering, etc. |
\\[allout-kill-line] allout-kill-line Like kill-line, but reconciles numbering, etc. |
1268 |
C-y allout-yank Yank, adjusting depth of yanked topic to |
\\[allout-yank] allout-yank Yank, adjusting depth of yanked topic to |
1269 |
depth of heading if yanking into bare topic |
depth of heading if yanking into bare topic |
1270 |
heading (ie, prefix sans text). |
heading (ie, prefix sans text). |
1271 |
M-y allout-yank-pop Is to allout-yank as yank-pop is to yank |
\\[allout-yank-pop] allout-yank-pop Is to allout-yank as yank-pop is to yank |
1272 |
|
|
1273 |
Misc commands: |
Misc commands: |
1274 |
------------- |
------------- |
1275 |
M-x outlineify-sticky Activate outline mode for current buffer, |
M-x outlineify-sticky Activate outline mode for current buffer, |
1276 |
and establish a default file-var setting |
and establish a default file-var setting |
1277 |
for `allout-layout'. |
for `allout-layout'. |
1278 |
C-c C-SPC allout-mark-topic |
\\[allout-mark-topic] allout-mark-topic |
1279 |
C-c = c allout-copy-exposed-to-buffer |
\\[allout-copy-exposed-to-buffer] allout-copy-exposed-to-buffer |
1280 |
Duplicate outline, sans concealed text, to |
Duplicate outline, sans concealed text, to |
1281 |
buffer with name derived from derived from that |
buffer with name derived from derived from that |
1282 |
of current buffer - \"*BUFFERNAME exposed*\". |
of current buffer - \"*BUFFERNAME exposed*\". |
1283 |
C-c = p allout-flatten-exposed-to-buffer |
\\[allout-flatten-exposed-to-buffer] allout-flatten-exposed-to-buffer |
1284 |
Like above 'copy-exposed', but convert topic |
Like above 'copy-exposed', but convert topic |
1285 |
prefixes to section.subsection... numeric |
prefixes to section.subsection... numeric |
1286 |
format. |
format. |
1290 |
Encrypted Entries |
Encrypted Entries |
1291 |
|
|
1292 |
Outline mode supports easily togglable gpg encryption of topics, with |
Outline mode supports easily togglable gpg encryption of topics, with |
1293 |
niceities like support for symmetric and key-pair modes, key timeout, key |
niceties like support for symmetric and key-pair modes, passphrase timeout, |
1294 |
consistency checking, user-provided hinting for symmetric key mode, and |
passphrase consistency checking, user-provided hinting for symmetric key |
1295 |
auto-encryption of topics pending encryption on save. The aim is to enable |
mode, and auto-encryption of topics pending encryption on save. The aim is |
1296 |
reliable topic privacy while preventing accidents like neglected |
to enable reliable topic privacy while preventing accidents like neglected |
1297 |
encryption, encryption with a mistaken key, forgetting which key was used, |
encryption, encryption with a mistaken passphrase, forgetting which |
1298 |
and other practical pitfalls. |
passphrase was used, and other practical pitfalls. |
1299 |
|
|
1300 |
See the `allout-toggle-current-subtree-encryption' function and |
See the `allout-toggle-current-subtree-encryption' function and |
1301 |
`allout-encrypt-unencrypted-on-saves' customization variable for details. |
`allout-encrypt-unencrypted-on-saves' customization variable for details. |
1413 |
;; allout-mode already called once during this complex command? |
;; allout-mode already called once during this complex command? |
1414 |
(same-complex-command (eq allout-v18/19-file-var-hack |
(same-complex-command (eq allout-v18/19-file-var-hack |
1415 |
(car command-history))) |
(car command-history))) |
1416 |
|
(write-file-hook-var-name (if (boundp 'write-file-functions) |
1417 |
|
'write-file-functions |
1418 |
|
'local-write-file-hooks)) |
1419 |
do-layout |
do-layout |
1420 |
) |
) |
1421 |
|
|
1466 |
(allout-resumptions 'selective-display) |
(allout-resumptions 'selective-display) |
1467 |
(if (and (boundp 'before-change-functions) before-change-functions) |
(if (and (boundp 'before-change-functions) before-change-functions) |
1468 |
(allout-resumptions 'before-change-functions)) |
(allout-resumptions 'before-change-functions)) |
1469 |
(setq local-write-file-hooks |
(set write-file-hook-var-name |
1470 |
(delq 'allout-write-file-hook-handler |
(delq 'allout-write-file-hook-handler |
1471 |
local-write-file-hooks)) |
(symbol-value write-file-hook-var-name))) |
1472 |
(setq auto-save-hook |
(setq auto-save-hook |
1473 |
(delq 'allout-auto-save-hook-handler |
(delq 'allout-auto-save-hook-handler |
1474 |
auto-save-hook)) |
auto-save-hook)) |
1529 |
(allout-resumptions 'selective-display '(t)) |
(allout-resumptions 'selective-display '(t)) |
1530 |
(add-hook 'pre-command-hook 'allout-pre-command-business) |
(add-hook 'pre-command-hook 'allout-pre-command-business) |
1531 |
(add-hook 'post-command-hook 'allout-post-command-business) |
(add-hook 'post-command-hook 'allout-post-command-business) |
1532 |
(add-hook 'local-write-file-hooks 'allout-write-file-hook-handler) |
(add-hook write-file-hook-var-name 'allout-write-file-hook-handler) |
|
(make-variable-buffer-local 'auto-save-hook) |
|
1533 |
(add-hook 'auto-save-hook 'allout-auto-save-hook-handler) |
(add-hook 'auto-save-hook 'allout-auto-save-hook-handler) |
1534 |
; Custom auto-fill func, to support |
; Custom auto-fill func, to support |
1535 |
; respect for topic headline, |
; respect for topic headline, |
2466 |
last-command-char) |
last-command-char) |
2467 |
;; Only xemacs has characterp. |
;; Only xemacs has characterp. |
2468 |
((and (fboundp 'characterp) |
((and (fboundp 'characterp) |
2469 |
(characterp last-command-char)) |
(apply 'characterp |
2470 |
(char-to-int last-command-char)) |
(list last-command-char))) |
2471 |
|
(apply 'char-to-int (list last-command-char))) |
2472 |
(t 0))) |
(t 0))) |
2473 |
mapped-binding) |
mapped-binding) |
2474 |
(if (zerop this-key-num) |
(if (zerop this-key-num) |
3472 |
;; ensure prior kill-ring leader is properly restored: |
;; ensure prior kill-ring leader is properly restored: |
3473 |
(if (eq leading-kill-ring-entry (cadr kill-ring)) |
(if (eq leading-kill-ring-entry (cadr kill-ring)) |
3474 |
;; Aborted kill got pushed on front - ditch it: |
;; Aborted kill got pushed on front - ditch it: |
3475 |
(pop kill-ring) |
(let ((got (car kill-ring))) |
3476 |
|
(setq kill-ring (cdr kill-ring)) |
3477 |
|
got) |
3478 |
;; Aborted kill got appended to prior - resurrect prior: |
;; Aborted kill got appended to prior - resurrect prior: |
3479 |
(setcar kill-ring leading-kill-ring-entry)) |
(setcar kill-ring leading-kill-ring-entry)) |
3480 |
;; make last-command skip this failed command, so kill-appending |
;; make last-command skip this failed command, so kill-appending |
4576 |
(while text |
(while text |
4577 |
(insert (car text)) |
(insert (car text)) |
4578 |
(if (setq text (cdr text)) |
(if (setq text (cdr text)) |
4579 |
(insert-string "\n"))) |
(insert "\n"))) |
4580 |
(insert "\n"))) |
(insert "\n"))) |
4581 |
;;;_ > allout-copy-exposed-to-buffer (&optional arg tobuf format) |
;;;_ > allout-copy-exposed-to-buffer (&optional arg tobuf format) |
4582 |
(defun allout-copy-exposed-to-buffer (&optional arg tobuf format) |
(defun allout-copy-exposed-to-buffer (&optional arg tobuf format) |
4849 |
(goto-char start-pt))) |
(goto-char start-pt))) |
4850 |
|
|
4851 |
;;;_ #8 Encryption |
;;;_ #8 Encryption |
4852 |
;;;_ > allout-toggle-current-subtree-encryption (&optional fetch-key) |
;;;_ > allout-toggle-current-subtree-encryption (&optional fetch-pass) |
4853 |
(defun allout-toggle-current-subtree-encryption (&optional fetch-key) |
(defun allout-toggle-current-subtree-encryption (&optional fetch-pass) |
4854 |
"Encrypt clear text or decrypt encoded contents of a topic. |
"Encrypt clear text or decrypt encoded topic contents \(body and subtopics.) |
4855 |
|
|
4856 |
Contents includes body and subtopics. |
Optional FETCH-PASS universal argument provokes key-pair encryption with |
4857 |
|
single universal argument. With doubled universal argument \(value = 16), |
4858 |
|
it forces prompting for the passphrase regardless of availability from the |
4859 |
|
passphrase cache. With no universal argument, the appropriate passphrase |
4860 |
|
for the is obtained from the cache, if available, else from the user. |
4861 |
|
|
4862 |
Currently only GnuPG encryption is supported. |
Currently only GnuPG encryption is supported. |
4863 |
|
|
4869 |
|
|
4870 |
Encrypted topic's bullet is set to a `~' to signal that the contents of the |
Encrypted topic's bullet is set to a `~' to signal that the contents of the |
4871 |
topic \(body and subtopics, but not heading) is pending encryption or |
topic \(body and subtopics, but not heading) is pending encryption or |
4872 |
encrypted. An `*' asterisk immediately after the bullet signals that the |
encrypted. `*' asterisk immediately after the bullet signals that the body |
4873 |
body is encrypted, its absence means it's meant to be encrypted but is not |
is encrypted, its' absence means the topic is meant to be encrypted but is |
4874 |
- it's \"disclosed\". When a file with disclosed topics is saved, the user |
not. When a file with topics pending encryption is saved, topics pending |
4875 |
prompted for an ok to \(symmetric-key) encrypt the disclosed topics. NOTE |
encryption are encrypted. See allout-encrypt-unencrypted-on-saves for |
4876 |
WELL that you must explicitly \(re)encrypt key-pair encrypted topics if you |
auto-encryption specifics. |
4877 |
want them to continue to be in key-pair mode. |
|
4878 |
|
\**NOTE WELL** that automatic encryption that happens during saves will |
4879 |
|
default to symmetric encryption - you must manually \(re)encrypt key-pair |
4880 |
|
encrypted topics if you want them to continue to use the key-pair cipher. |
4881 |
|
|
4882 |
Level-1 topics, with prefix consisting solely of an `*' asterisk, cannot be |
Level-1 topics, with prefix consisting solely of an `*' asterisk, cannot be |
4883 |
encrypted. If you want to encrypt the contents of a top-level topic, use |
encrypted. If you want to encrypt the contents of a top-level topic, use |
4884 |
\\[allout-shift-in] to increase its depth. |
\\[allout-shift-in] to increase its depth. |
4885 |
|
|
4886 |
Failed transformation does not change the an entry being encrypted - |
Passphrase Caching |
|
instead, the key is re-solicited and the transformation is retried. |
|
|
\\[keyboard-quit] to abort. |
|
|
|
|
|
Decryption does symmetric or key-pair key mode depending on how the text |
|
|
was encrypted. The encryption key is solicited if not currently available |
|
|
from the key cache from a recent prior encryption action. |
|
|
|
|
|
Optional FETCH-KEY universal argument is used for two purposes - to provoke |
|
|
key-pair instead of symmetric encryption, or to provoke clearing of the key |
|
|
cache so keys are freshly fetched. |
|
|
|
|
|
- Without any universal arguments, then the appropriate key for the is |
|
|
obtained from the cache, if available, else from the user. |
|
|
|
|
|
- If FETCH-KEY is the result of one universal argument - ie, equal to 4 - |
|
|
then key-pair encryption is used. |
|
|
|
|
|
- With repeated universal argument - equal to 16 - then the key cache is |
|
|
cleared before any encryption transformations, to force prompting of the |
|
|
user for the key. |
|
|
|
|
|
The solicited key is retained for reuse in a buffer-specific cache for some |
|
|
set period of time \(default, 60 seconds), after which the string is |
|
|
nulled. `mailcrypt' provides the key caching functionality. You can |
|
|
adjust the key cache timeout by ajdusting the setting of the elisp variable |
|
|
`mc-passwd-timeout'. |
|
|
|
|
|
If the file previously had no associated key, or had a different key than |
|
|
specified, the user is prompted to repeat the new one for corroboration. A |
|
|
random string encrypted by the new key is set on the buffer-specific |
|
|
variable `allout-key-verifier-string', for confirmation of the key when |
|
|
next obtained, before encrypting or decrypting anything with it. This |
|
|
helps avoid mistakenly shifting between keys. |
|
|
|
|
|
If allout customization var `allout-key-verifier-handling' is non-nil, an |
|
|
entry for `allout-key-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 key verifier across emacs |
|
|
sessions. |
|
|
|
|
|
Similarly, `allout-key-hint-string' stores a user-provided reminder about |
|
|
their key, and `allout-key-hint-handling' specifies when the hint is |
|
|
presented, or if key hints are disabled. If enabled \(see the |
|
|
`allout-key-hint-handling' docstring for details), the hint string is |
|
|
stored in the local-variables section of the file, and solicited whenever |
|
|
the key is changed." |
|
4887 |
|
|
4888 |
;;; This routine handles allout-specific business, dispatching |
The encryption passphrase is solicited if not currently available in the |
4889 |
;;; encryption-specific business to allout-encrypt-string. |
passphrase cache from a recent encryption action. |
4890 |
|
|
4891 |
|
The solicited passphrase is retained for reuse in a buffer-specific cache |
4892 |
|
for some set period of time \(default, 60 seconds), after which the string |
4893 |
|
is nulled. The passphrase cache timeout is customized by setting |
4894 |
|
`pgg-passphrase-cache-expiry'. |
4895 |
|
|
4896 |
|
Symmetric Passphrase Hinting and Verification |
4897 |
|
|
4898 |
|
If the file previously had no associated passphrase, or had a different |
4899 |
|
passphrase than specified, the user is prompted to repeat the new one for |
4900 |
|
corroboration. A random string encrypted by the new passphrase is set on |
4901 |
|
the buffer-specific variable `allout-passphrase-verifier-string', for |
4902 |
|
confirmation of the passphrase when next obtained, before encrypting or |
4903 |
|
decrypting anything with it. This helps avoid mistakenly shifting between |
4904 |
|
keys. |
4905 |
|
|
4906 |
|
If allout customization var `allout-passphrase-verifier-handling' is |
4907 |
|
non-nil, an entry for `allout-passphrase-verifier-string' and its value is |
4908 |
|
added to an Emacs 'local variables' section at the end of the file, which |
4909 |
|
is created if necessary. That setting is for retention of the passphrase |
4910 |
|
verifier across emacs sessions. |
4911 |
|
|
4912 |
|
Similarly, `allout-passphrase-hint-string' stores a user-provided reminder |
4913 |
|
about their passphrase, and `allout-passphrase-hint-handling' specifies |
4914 |
|
when the hint is presented, or if passphrase hints are disabled. If |
4915 |
|
enabled \(see the `allout-passphrase-hint-handling' docstring for details), |
4916 |
|
the hint string is stored in the local-variables section of the file, and |
4917 |
|
solicited whenever the passphrase is changed." |
4918 |
|
|
4919 |
(interactive "P") |
(interactive "P") |
4920 |
(save-excursion |
(save-excursion |
4924 |
(error (concat "Cannot encrypt or decrypt level 1 topics -" |
(error (concat "Cannot encrypt or decrypt level 1 topics -" |
4925 |
" shift it in to make it encryptable"))) |
" shift it in to make it encryptable"))) |
4926 |
|
|
|
(if (and fetch-key |
|
|
(not (equal fetch-key '(4)))) |
|
|
(mc-deactivate-passwd)) |
|
|
|
|
4927 |
(let* ((allout-buffer (current-buffer)) |
(let* ((allout-buffer (current-buffer)) |
4928 |
;; Asses location: |
;; Asses location: |
4929 |
(after-bullet-pos (point)) |
(after-bullet-pos (point)) |
4930 |
(was-encrypted |
(was-encrypted |
4931 |
(progn (if (= (point-max) after-bullet-pos) |
(progn (if (= (point-max) after-bullet-pos) |
4932 |
(error "no body to encrypt")) |
(error "no body to encrypt")) |
4933 |
(looking-at "\\*"))) |
(allout-encrypted-topic-p))) |
4934 |
(was-collapsed (if (not (re-search-forward "[\n\r]" nil t)) |
(was-collapsed (if (not (re-search-forward "[\n\r]" nil t)) |
4935 |
nil |
nil |
4936 |
(backward-char 1) |
(backward-char 1) |
4946 |
(error "No topic contents to %scrypt" |
(error "No topic contents to %scrypt" |
4947 |
(if was-encrypted "de" "en")))) |
(if was-encrypted "de" "en")))) |
4948 |
;; Assess key parameters: |
;; Assess key parameters: |
4949 |
(key-type (or |
(key-info (or |
4950 |
;; detect the type by which it is already encrypted |
;; detect the type by which it is already encrypted |
4951 |
(and was-encrypted |
(and was-encrypted |
4952 |
(allout-encrypted-text-type subject-text)) |
(allout-encrypted-key-info subject-text)) |
4953 |
(and (member fetch-key '(4 (4))) |
(and (member fetch-pass '(4 (4))) |
4954 |
(yes-or-no-p "Use key-pair encryption instead? ") |
'(keypair nil)) |
4955 |
'keypair) |
'(symmetric nil))) |
4956 |
'symmetric)) |
(for-key-type (car key-info)) |
4957 |
(fetch-key (and fetch-key (not (member fetch-key '(16 (16)))))) |
(for-key-identity (cadr key-info)) |
4958 |
|
(fetch-pass (and fetch-pass (member fetch-pass '(16 (16))))) |
4959 |
result-text) |
result-text) |
4960 |
|
|
4961 |
(setq result-text |
(setq result-text |
4962 |
(allout-encrypt-string subject-text was-encrypted |
(allout-encrypt-string subject-text was-encrypted |
4963 |
(current-buffer) key-type fetch-key)) |
(current-buffer) |
4964 |
|
for-key-type for-key-identity fetch-pass)) |
4965 |
|
|
4966 |
;; Replace the subtree with the processed product. |
;; Replace the subtree with the processed product. |
4967 |
(allout-unprotected |
(allout-unprotected |
4995 |
) |
) |
4996 |
) |
) |
4997 |
) |
) |
4998 |
;;;_ > allout-encrypt-string (text decrypt allout-buffer key-type rekey |
;;;_ > allout-encrypt-string (text decrypt allout-buffer key-type for-key |
4999 |
;;; &optional retried verifying) |
;;; fetch-pass &optional retried verifying |
5000 |
(defun allout-encrypt-string (text decrypt allout-buffer key-type rekey |
;;; passphrase) |
5001 |
&optional retried verifying) |
(defun allout-encrypt-string (text decrypt allout-buffer key-type for-key |
5002 |
"Encrypt or decrypt a string TEXT using KEY. |
fetch-pass &optional retried verifying |
5003 |
|
passphrase) |
5004 |
If optional DECRYPT is true (default false), then decrypt instead of |
"Encrypt or decrypt message TEXT. |
5005 |
encrypt. |
|
5006 |
|
If DECRYPT is true (default false), then decrypt instead of encrypt. |
5007 |
|
|
5008 |
|
FETCH-PASS (default false) forces fresh prompting for the passphrase. |
5009 |
|
|
5010 |
Optional REKEY (default false) provokes clearing of the key cache to force |
KEY-TYPE indicates whether to use a 'symmetric or 'keypair cipher. |
|
fresh prompting for the key. |
|
5011 |
|
|
5012 |
Optional RETRIED is for internal use - conveys the number of failed keys have |
FOR-KEY is human readable identification of the first of the user's |
5013 |
been solicited in sequence leading to this current call. |
eligible secret keys a keypair decryption targets, or else nil. |
5014 |
|
|
5015 |
Optional VERIFYING is for internal use, signifying processing of text |
Optional RETRIED is for internal use - conveys the number of failed keys |
5016 |
solely for verification of the cached key. |
that have been solicited in sequence leading to this current call. |
5017 |
|
|
5018 |
|
Optional PASSPHRASE enables explicit delivery of the decryption passphrase, |
5019 |
|
for verification purposes. |
5020 |
|
|
5021 |
Returns the resulting string, or nil if the transformation fails." |
Returns the resulting string, or nil if the transformation fails." |
5022 |
|
|
5023 |
;; Ensure that we have an alternate handle on the real mc-activate-passwd: |
(require 'pgg) |
|
(if (not (fboundp 'real-mc-activate-passwd)) |
|
|
;; Force loads of the primary mailcrypt packages, so flet below holds. |
|
|
(progn (require 'mailcrypt) |
|
|
(load "mc-toplev") |
|
|
(fset 'real-mc-activate-passwd |
|
|
(symbol-function 'mc-activate-passwd)))) |
|
5024 |
|
|
5025 |
(if (and rekey (not verifying)) (mc-deactivate-passwd)) |
(let* ((scheme (upcase |
5026 |
|
(format "%s" (or pgg-scheme pgg-default-scheme "GPG")))) |
5027 |
|
(for-key (and (equal key-type 'keypair) |
5028 |
|
(or for-key |
5029 |
|
(split-string (read-string |
5030 |
|
(format "%s message recipients: " |
5031 |
|
scheme)) |
5032 |
|
"[ \t,]+")))) |
5033 |
|
(target-prompt-id (if (equal key-type 'keypair) |
5034 |
|
(if (= (length for-key) 1) |
5035 |
|
(car for-key) for-key) |
5036 |
|
(buffer-name allout-buffer))) |
5037 |
|
(target-cache-id (format "%s-%s" |
5038 |
|
key-type |
5039 |
|
(if (equal key-type 'keypair) |
5040 |
|
target-prompt-id |
5041 |
|
(or (buffer-file-name allout-buffer) |
5042 |
|
target-prompt-id)))) |
5043 |
|
(comment "Processed by allout driving pgg") |
5044 |
|
work-buffer result result-text status) |
5045 |
|
|
5046 |
|
(if (and fetch-pass (not passphrase)) |
5047 |
|
;; Force later fetch by evicting passphrase from the cache. |
5048 |
|
(pgg-remove-passphrase-from-cache target-cache-id t)) |
5049 |
|
|
5050 |
|
(catch 'encryption-failed |
5051 |
|
|
5052 |
|
;; Obtain the passphrase if we don't already have one and we're not |
5053 |
|
;; doing a keypair encryption: |
5054 |
|
(if (not (or passphrase |
5055 |
|
(and (equal key-type 'keypair) |
5056 |
|
(not decrypt)))) |
5057 |
|
|
5058 |
|
(setq passphrase (allout-obtain-passphrase for-key |
5059 |
|
target-cache-id |
5060 |
|
target-prompt-id |
5061 |
|
key-type |
5062 |
|
allout-buffer |
5063 |
|
retried fetch-pass))) |
5064 |
|
(with-temp-buffer |
5065 |
|
|
5066 |
(catch 'encryption-failed |
(insert (subst-char-in-string ?\r ?\n text)) |
5067 |
(save-excursion |
|
5068 |
|
(cond |
5069 |
|
|
5070 |
(let* ((mc-default-scheme (or allout-encryption-scheme |
;; symmetric: |
5071 |
allout-default-encryption-scheme)) |
((equal key-type 'symmetric) |
5072 |
(id (format "%s-%s" key-type |
(setq status |
5073 |
(or (buffer-file-name allout-buffer) |
(if decrypt |
5074 |
(buffer-name allout-buffer)))) |
|
5075 |
(cached (real-mc-activate-passwd id nil)) |
(pgg-decrypt (point-min) (point-max) passphrase) |
5076 |
(comment "Processed by allout driving mailcrypt") |
|
5077 |
key work-buffer result result-text encryption-process-status) |
(pgg-encrypt-symmetric (point-min) (point-max) |
5078 |
|
passphrase))) |
5079 |
(unwind-protect |
|
5080 |
|
(if status |
5081 |
;; Interject our mc-activate-passwd wrapper: |
(pgg-situate-output (point-min) (point-max)) |
5082 |
(flet ((mc-activate-passwd (id &optional prompt) |
;; failed - handle passphrase caching |
5083 |
(allout-mc-activate-passwd id prompt))) |
(if verifying |
5084 |
|
(throw 'encryption-failed nil) |
5085 |
(setq work-buffer |
(pgg-remove-passphrase-from-cache target-cache-id t) |
5086 |
(set-buffer (allout-encryption-produce-work-buffer text))) |
(error "Symmetric-cipher encryption failed - %s" |
5087 |
|
"try again with different passphrase.")))) |
5088 |
(cond |
|
5089 |
|
;; encrypt 'keypair: |
5090 |
;; symmetric: |
((not decrypt) |
5091 |
((equal key-type 'symmetric) |
|
5092 |
(setq key (if verifying |
(setq status |
5093 |
(real-mc-activate-passwd id nil) |
|
5094 |
(allout-mc-activate-passwd id))) |
(pgg-encrypt for-key |
5095 |
(setq encryption-process-status |
nil (point-min) (point-max) passphrase)) |
5096 |
(crypt-encrypt-buffer key decrypt)) |
|
5097 |
(if (zerop encryption-process-status) |
(if status |
5098 |
t |
(pgg-situate-output (point-min) (point-max)) |
5099 |
(if verifying |
(error (pgg-remove-passphrase-from-cache target-cache-id t) |
5100 |
(throw 'encryption-failed nil) |
(error "encryption failed")))) |
5101 |
(mc-deactivate-passwd) |
|
5102 |
(error "Symmetric-key encryption failed (%s) - wrong key?" |
;; decrypt 'keypair: |
5103 |
encryption-process-status)))) |
(t |
5104 |
|
|
5105 |
;; encrypt 'keypair: |
(setq status |
5106 |
((not decrypt) |
(pgg-decrypt (point-min) (point-max) passphrase)) |
5107 |
(condition-case result |
|
5108 |
(mailcrypt-encrypt 1) |
(if status |
5109 |
(error (mc-deactivate-passwd) |
(pgg-situate-output (point-min) (point-max)) |
5110 |
(error "encryption failed: %s" |
(error (pgg-remove-passphrase-from-cache target-cache-id t) |
5111 |
(cadr result))))) |
(error "decryption failed")))) |
5112 |
|
) |
5113 |
;; decrypt 'keypair: |
|
5114 |
(t (condition-case result |
(setq result-text |
5115 |
(mc-decrypt) |
(buffer-substring 1 (- (point-max) (if decrypt 0 1)))) |
5116 |
(error (mc-deactivate-passwd) |
|
5117 |
(error "decryption failed: %s" |
;; validate result - non-empty |
5118 |
(cadr result)))))) |
(cond ((not result-text) |
5119 |
|
(if verifying |
5120 |
(setq result-text (if (or (equal key-type 'keypair) |
nil |
5121 |
(not decrypt)) |
;; transform was fruitless, retry w/new passphrase. |
5122 |
(buffer-substring 1 (1- (point-max))) |
(pgg-remove-passphrase-from-cache target-cache-id t) |
5123 |
(buffer-string))) |
(allout-encrypt-string text allout-buffer decrypt nil |
5124 |
;; validate result - non-empty |
(if retried (1+ retried) 1) |
5125 |
(cond ((not result-text) |
passphrase))) |
5126 |
(if verifying |
|
5127 |
nil |
;; Barf if encryption yields extraordinary control chars: |
5128 |
;; Transformation was fruitless - retry with new key. |
((and (not decrypt) |
5129 |
(mc-deactivate-passwd) |
(string-match "[\C-a\C-k\C-o-\C-z\C-@]" |
5130 |
(allout-encrypt-string text allout-buffer decrypt nil |
result-text)) |
5131 |
(if retried (1+ retried) 1) |
(error (concat "encryption produced unusable" |
5132 |
verifying))) |
" non-armored text - reconfigure!"))) |
5133 |
|
|
5134 |
;; Barf if encryption yields extraordinary control chars: |
;; valid result and just verifying or non-symmetric: |
5135 |
((and (not decrypt) |
((or verifying (not (equal key-type 'symmetric))) |
5136 |
(string-match "[\C-a\C-k\C-o-\C-z\C-@]" result-text)) |
(if (or verifying decrypt) |
5137 |
(error (concat "encryption produced unusable" |
(pgg-add-passphrase-to-cache target-cache-id |
5138 |
" non-armored text - reconfigure!"))) |
passphrase t)) |
5139 |
|
result-text) |
5140 |
;; valid result and just verifying or non-symmetric: |
|
5141 |
((or verifying (not (equal key-type 'symmetric))) |
;; valid result and regular symmetric - "register" |
5142 |
result-text) |
;; passphrase with mnemonic aids/cache. |
5143 |
|
(t |
5144 |
;; valid result and regular symmetric - situate validator: |
(set-buffer allout-buffer) |
5145 |
(t |
(if passphrase |
5146 |
;; valid result and verifier needs to be situated in |
(pgg-add-passphrase-to-cache target-cache-id |
5147 |
;; allout-buffer: |
passphrase t)) |
5148 |
(set-buffer allout-buffer) |
(allout-update-passphrase-mnemonic-aids for-key passphrase |
5149 |
(if (and (or rekey (not cached)) |
allout-buffer) |
5150 |
(not (allout-verify-key key allout-buffer))) |
result-text) |
5151 |
(allout-situate-encryption-key-verifier key id)) |
) |
|
result-text) |
|
|
) |
|
|
) |
|
|
|
|
|
;; unwind-protect emergence: |
|
|
(if work-buffer |
|
|
(kill-buffer work-buffer)) |
|
5152 |
) |
) |
5153 |
) |
) |
|
) |
|
5154 |
) |
) |
5155 |
) |
) |
5156 |
;;;_ > allout-mc-activate-passwd (id &optional prompt) |
;;;_ > allout-obtain-passphrase (for-key cache-id prompt-id key-type |
5157 |
(defun allout-mc-activate-passwd (id &optional prompt) |
;;; allout-buffer retried fetch-pass) |
5158 |
"Substituted for mc-activate-passwd during allout outline encryption. |
(defun allout-obtain-passphrase (for-key cache-id prompt-id key-type |
5159 |
|
allout-buffer retried fetch-pass) |
5160 |
We add key-verification to vanilla mc-activate-passwd. |
"Obtain passphrase for a key from the cache or else from the user. |
5161 |
|
|
5162 |
We depend in some cases on values of the following allout-encrypt-string |
When obtaining from the user, symmetric-cipher passphrases are verified |
5163 |
internal or prevailing variables: |
against either, if available and enabled, a random string that was |
5164 |
- key-type - 'symmetric or 'keypair |
encrypted against the passphrase, or else against repeated entry by the |
5165 |
- id - id associated with current key in key cache |
user for corroboration. |
5166 |
- allout-buffer - where subject text resides |
|
5167 |
- retried - number of current attempts to obtain this key |
FOR-KEY is the key for which the passphrase is being obtained. |
5168 |
- rekey - user asked to present a new key - needs to be confirmed" |
|
5169 |
|
CACHE-ID is the cache id of the key for the passphrase. |
5170 |
;; - if we're doing non-symmetric key, just do normal mc-activate-passwd |
|
5171 |
;; - otherwise, if we are have a cached version of the key, then assume |
PROMPT-ID is the id for use when prompting the user. |
5172 |
;; it's verified and return it |
|
5173 |
;; - otherwise, prompt for a key, and: |
KEY-TYPE is either 'symmetric or 'keypair. |
5174 |
;; - if we have a key verifier \(a string value which should decrypt |
|
5175 |
;; against a symmetric key), validate against the verifier |
ALLOUT-BUFFER is the buffer containing the entry being en/decrypted. |
5176 |
;; - if successful, return the verified key |
|
5177 |
;; - if unsuccessful: |
RETRIED is the number of this attempt to obtain this passphrase. |
5178 |
;; - offer to use the new key |
|
5179 |
;; - if accepted, do confirm process |
FETCH-PASS causes the passphrase to be solicited from the user, regardless |
5180 |
;; - if refused, try again until we get a correctly spelled one or the |
of the availability of a cached copy." |
|
;; user quits |
|
|
;; - if no key verifier, resolicit the key to get corroboration and return |
|
|
;; the corroborated key if spelled identically, or error if not. |
|
5181 |
|
|
5182 |
(if (not (equal key-type 'symmetric)) |
(if (not (equal key-type 'symmetric)) |
5183 |
;; do regular mc-activate-passwd on non-symmetric key |
;; do regular passphrase read on non-symmetric passphrase: |
5184 |
(real-mc-activate-passwd id prompt) |
(pgg-read-passphrase (format "%s passphrase%s: " |
5185 |
|
(upcase (format "%s" (or pgg-scheme |
5186 |
|
pgg-default-scheme |
5187 |
|
"GPG"))) |
5188 |
|
(if prompt-id |
5189 |
|
(format " for %s" prompt-id) |
5190 |
|
"")) |
5191 |
|
cache-id t) |
5192 |
|
|
5193 |
;; Symmetric hereon: |
;; Symmetric hereon: |
5194 |
|
|
5195 |
(save-excursion |
(save-excursion |
5196 |
(set-buffer allout-buffer) |
(set-buffer allout-buffer) |
5197 |
(let* ((hint (if (and (not (string= allout-key-hint-string "")) |
(let* ((hint (if (and (not (string= allout-passphrase-hint-string "")) |
5198 |
(or (equal allout-key-hint-handling 'always) |
(or (equal allout-passphrase-hint-handling 'always) |
5199 |
(and (equal allout-key-hint-handling 'needed) |
(and (equal allout-passphrase-hint-handling |
5200 |
|
'needed) |
5201 |
retried))) |
retried))) |
5202 |
(format " [%s]" allout-key-hint-string) |
(format " [%s]" allout-passphrase-hint-string) |
5203 |
"")) |
"")) |
5204 |
(retry-message (if retried (format " (%s retry)" retried) "")) |
(retry-message (if retried (format " (%s retry)" retried) "")) |
5205 |
(prompt-sans-hint (format "'%s' symmetric key%s: " |
(prompt-sans-hint (format "'%s' symmetric passphrase%s: " |
5206 |
(buffer-name allout-buffer) |
prompt-id retry-message)) |
5207 |
retry-message)) |
(full-prompt (format "'%s' symmetric passphrase%s%s: " |
5208 |
(full-prompt (format "'%s' symmetric key%s%s: " |
prompt-id hint retry-message)) |
|
(buffer-name allout-buffer) |
|
|
hint retry-message)) |
|
5209 |
(prompt full-prompt) |
(prompt full-prompt) |
5210 |
(verifier-string (allout-get-encryption-key-verifier)) |
(verifier-string (allout-get-encryption-passphrase-verifier)) |
5211 |
;; force retention of cached passwords for five minutes while |
|
5212 |
;; we're in this particular routine: |
(cached (and (not fetch-pass) |
5213 |
(mc-passwd-timeout 300) |
(pgg-read-passphrase-from-cache cache-id t))) |
5214 |
(cached (real-mc-activate-passwd id nil)) |
(got-pass (or cached |
5215 |
(got (or cached (real-mc-activate-passwd id full-prompt))) |
(pgg-read-passphrase full-prompt cache-id t))) |
5216 |
|
|
5217 |
confirmation) |
confirmation) |
5218 |
|
|
5219 |
(if (not got) |
(if (not got-pass) |
5220 |
nil |
nil |
5221 |
|
|
5222 |
;; Duplicate our handle on the key so it's not clobbered by |
;; Duplicate our handle on the passphrase so it's not clobbered by |
5223 |
;; deactivate-passwd memory clearing: |
;; deactivate-passwd memory clearing: |
5224 |
(setq got (format "%s" got)) |
(setq got-pass (format "%s" got-pass)) |
5225 |
|
|
5226 |
(cond (verifier-string |
(cond (verifier-string |
5227 |
(if (and (not (allout-encrypt-string |
(save-window-excursion |
5228 |
verifier-string 'decrypt allout-buffer |
(if (allout-encrypt-string verifier-string 'decrypt |
5229 |
'symmetric nil 0 'verifying)) |
allout-buffer 'symmetric |
5230 |
|
for-key nil 0 'verifying |
5231 |
|
got-pass) |
5232 |
|
(setq confirmation (format "%s" got-pass)))) |
5233 |
|
|
5234 |
|
(if (and (not confirmation) |
5235 |
(if (yes-or-no-p |
(if (yes-or-no-p |
5236 |
(concat "Key differs from established" |
(concat "Passphrase differs from established" |
5237 |
" - use new one instead? ")) |
" - use new one instead? ")) |
5238 |
;; deactivate password for subsequent |
;; deactivate password for subsequent |
5239 |
;; confirmation: |
;; confirmation: |
5240 |
(progn (mc-deactivate-passwd) |
(progn |
5241 |
(setq prompt prompt-sans-hint) |
(pgg-remove-passphrase-from-cache cache-id t) |
5242 |
nil) |
(setq prompt prompt-sans-hint) |
5243 |
|
nil) |
5244 |
t)) |
t)) |
5245 |
(progn (mc-deactivate-passwd) |
(progn (pgg-remove-passphrase-from-cache cache-id t) |
5246 |
(error "Wrong key.")))) |
(error "Wrong passphrase.")))) |
5247 |
;; Force confirmation by repetition for new key: |
;; No verifier string - force confirmation by repetition of |
5248 |
((or rekey (not cached)) (mc-deactivate-passwd)))) |
;; (new) passphrase: |
5249 |
;; we have a key and it's either verified and cached. |
((or fetch-pass (not cached)) |
5250 |
;; confirmation vs new input - doing mc-activate-passwd will do the |
(pgg-remove-passphrase-from-cache cache-id t)))) |
5251 |
|
;; confirmation vs new input - doing pgg-read-passphrase will do the |
5252 |
;; right thing, in either case: |
;; right thing, in either case: |
5253 |
(setq confirmation |
(if (not confirmation) |
5254 |
(real-mc-activate-passwd id (concat prompt |
(setq confirmation |
5255 |
" ... confirm spelling: "))) |
(pgg-read-passphrase (concat prompt |
5256 |
|
" ... confirm spelling: ") |
5257 |
|
cache-id t))) |
5258 |
(prog1 |
(prog1 |
5259 |
(if (equal got confirmation) |
(if (equal got-pass confirmation) |
5260 |
confirmation |
confirmation |
5261 |
(if (yes-or-no-p (concat "spelling of original and" |
(if (yes-or-no-p (concat "spelling of original and" |
5262 |
" confirmation differ - retry? ")) |
" confirmation differ - retry? ")) |
5263 |
(progn (setq retried (if retried (1+ retried) 1)) |
(progn (setq retried (if retried (1+ retried) 1)) |
5264 |
(mc-deactivate-passwd) |
(pgg-remove-passphrase-from-cache cache-id t) |
5265 |
;; recurse to this routine: |
;; recurse to this routine: |
5266 |
(mc-activate-passwd id prompt-sans-hint)) |
(pgg-read-passphrase prompt-sans-hint cache-id t)) |
5267 |
(mc-deactivate-passwd) |
(pgg-remove-passphrase-from-cache cache-id t) |
5268 |
(error "Confirmation failed."))) |
(error "Confirmation failed."))) |
5269 |
;; reduce opportunity for memory cherry-picking by zeroing duplicate: |
;; reduce opportunity for memory cherry-picking by zeroing duplicate: |
5270 |
(dotimes (i (length got)) |
(dotimes (i (length got-pass)) |
5271 |
(aset got i 0)) |
(aset got-pass i 0)) |
5272 |
) |
) |
5273 |
) |
) |
5274 |
) |
) |
5275 |
) |
) |
5276 |
) |
) |
|
;;;_ > allout-encryption-produce-work-buffer (text) |
|
|
(defun allout-encryption-produce-work-buffer (text) |
|
|
"Establish a new buffer filled with TEXT, for outline encrypion processing. |
|
|
|
|
|
TEXT is massaged so outline collapsing, if any, is removed." |
|
|
(let ((work-buffer (generate-new-buffer " *allout encryption*"))) |
|
|
(save-excursion |
|
|
(set-buffer work-buffer) |
|
|
(insert (subst-char-in-string ?\r ?\n text))) |
|
|
work-buffer)) |
|
5277 |
;;;_ > allout-encrypted-topic-p () |
;;;_ > allout-encrypted-topic-p () |
5278 |
(defun allout-encrypted-topic-p () |
(defun allout-encrypted-topic-p () |
5279 |
"True if the current topic is encryptable and encrypted." |
"True if the current topic is encryptable and encrypted." |
5284 |
(looking-at "\\*")) |
(looking-at "\\*")) |
5285 |
) |
) |
5286 |
) |
) |
5287 |
;;;_ > allout-encrypted-text-type (text) |
;;;_ > allout-encrypted-key-info (text) |
5288 |
;;; XXX gpg-specific, not generic! |
;; XXX gpg-specific, alas |
5289 |
(defun allout-encrypted-text-type (text) |
(defun allout-encrypted-key-info (text) |
5290 |
"For gpg encrypted text, return 'symmetric or 'keypair." |
"Return a pair of the key type and identity of a recipient's secret key. |
5291 |
|
|
5292 |
;; Ensure mc-gpg-path has a value: |
The key type is one of 'symmetric or 'keypair. |
5293 |
(if (not (boundp 'mc-gpg-path)) |
|
5294 |
(load-library "mc-gpg")) |
if 'keypair, and some of the user's secret keys are among those for which |
5295 |
|
the message was encoded, return the identity of the first. otherwise, |
5296 |
|
return nil for the second item of the pair. |
5297 |
|
|
5298 |
|
An error is raised if the text is not encrypted." |
5299 |
|
(require 'pgg-parse) |
5300 |
(save-excursion |
(save-excursion |
5301 |
(let* ((work-buffer (set-buffer |
(with-temp-buffer |
5302 |
(allout-encryption-produce-work-buffer text))) |
(insert (subst-char-in-string ?\r ?\n text)) |
5303 |
(result (mc-gpg-process-region (point-min) (point-max) |
(let* ((parsed-armor (pgg-parse-armor-region (point-min) (point-max))) |
5304 |
nil mc-gpg-path |
(type (if (pgg-gpg-symmetric-key-p parsed-armor) |
5305 |
'("--batch" "--decrypt") |
'symmetric |
5306 |
'mc-gpg-decrypt-parser |
'keypair)) |
5307 |
work-buffer nil))) |
secret-keys first-secret-key for-key-owner) |
5308 |
(cond ((equal (nth 0 result) 'symmetric) |
(if (equal type 'keypair) |
5309 |
'symmetric) |
(setq secret-keys (pgg-gpg-lookup-all-secret-keys) |
5310 |
((equal (nth 0 result) t) |
first-secret-key (pgg-gpg-select-matching-key parsed-armor |
5311 |
'keypair) |
secret-keys) |
5312 |
(t (error "Unrecognized/unsupported encryption type %S" |
for-key-owner (and first-secret-key |
5313 |
(nth 0 result)))) |
(pgg-gpg-lookup-key-owner |
5314 |
|
first-secret-key)))) |
5315 |
|
(list type (pgg-gpg-key-id-from-key-owner for-key-owner)) |
5316 |
|
) |
5317 |
) |
) |
5318 |
) |
) |
5319 |
) |
) |
5320 |
;;;_ > allout-create-encryption-key-verifier (key id) |
;;;_ > allout-create-encryption-passphrase-verifier (passphrase) |
5321 |
(defun allout-create-encryption-key-verifier (key id) |
(defun allout-create-encryption-passphrase-verifier (passphrase) |
5322 |
"Encrypt a random message for later validation of symmetric key." |
"Encrypt random message for later validation of symmetric key's passphrase." |
5323 |
;; use 20 random ascii characters, across the entire ascii range. |
;; use 20 random ascii characters, across the entire ascii range. |
5324 |
(random t) |
(random t) |
5325 |
(let ((spew (make-string 20 ?\0))) |
(let ((spew (make-string 20 ?\0))) |
5326 |
(dotimes (i (length spew)) |
(dotimes (i (length spew)) |
5327 |
(aset spew i (1+ (random 254)))) |
(aset spew i (1+ (random 254)))) |
5328 |
(allout-encrypt-string spew nil nil 'symmetric nil nil t)) |
(allout-encrypt-string spew nil (current-buffer) 'symmetric |
5329 |
|
nil nil 0 passphrase)) |
5330 |
) |
) |
5331 |
;;;_ > allout-situate-encryption-key-verifier (key id) |
;;;_ > allout-update-passphrase-mnemonic-aids (for-key passphrase |
5332 |
(defun allout-situate-encryption-key-verifier (key id) |
;;; outline-buffer) |
5333 |
"Establish key verifier string on file variable. |
(defun allout-update-passphrase-mnemonic-aids (for-key passphrase |
5334 |
|
outline-buffer) |
5335 |
We also prompt for and situate a new reminder, if reminders are enabled. |
"Update passphrase verifier and hint strings if necessary. |
5336 |
|
|
5337 |
We massage the string to simplify programmatic adjustment. File variable |
See `allout-passphrase-verifier-string' and `allout-passphrase-hint-string' |
5338 |
is `allout-file-key-verifier-string'." |
settings. |
5339 |
(let ((verifier-string |
|
5340 |
;; Collapse to a single line and enclose in string quotes: |
PASSPHRASE is the passphrase being mnemonicized |
5341 |
(subst-char-in-string ?\n ?\C-a |
|
5342 |
(allout-create-encryption-key-verifier |
OUTLINE-BUFFER is the buffer of the outline being adjusted. |
5343 |
key id))) |
|
5344 |
(reminder (if (not (equal allout-key-hint-handling 'disabled)) |
These are used to help the user keep track of the passphrase they use for |
5345 |
(read-from-minibuffer |
symmetric encryption in the file. |
5346 |
"Key hint to jog your memory next time: " |
|
5347 |
allout-key-hint-string)))) |
Behavior is governed by `allout-passphrase-verifier-handling', |
5348 |
(setq allout-key-verifier-string verifier-string) |
`allout-passphrase-hint-handling', and also, controlling whether the values |
5349 |
(allout-adjust-file-variable "allout-key-verifier-string" |
are preserved on Emacs local file variables, |
5350 |
verifier-string) |
`allout-enable-file-variable-adjustment'." |
5351 |
(cond ((equal allout-key-hint-handling 'disabled) |
|
5352 |
nil) |
;; If passphrase doesn't agree with current verifier: |
5353 |
((not (string= reminder allout-key-hint-string)) |
;; - adjust the verifier |
5354 |
(setq allout-key-hint-string reminder) |
;; - if passphrase hint handling is enabled, adjust the passphrase hint |
5355 |
(allout-adjust-file-variable "allout-key-hint-string" |
;; - if file var settings are enabled, adjust the file vars |
5356 |
reminder))) |
|
5357 |
|
(let* ((new-verifier-needed (not (allout-verify-passphrase |
5358 |
|
for-key passphrase outline-buffer))) |
5359 |
|
(new-verifier-string |
5360 |
|
(if new-verifier-needed |
5361 |
|
;; Collapse to a single line and enclose in string quotes: |
5362 |
|
(subst-char-in-string |
5363 |
|
?\n ?\C-a (allout-create-encryption-passphrase-verifier |
5364 |
|
passphrase)))) |
5365 |
|
new-hint) |
5366 |
|
(when new-verifier-string |
5367 |
|
;; do the passphrase hint first, since it's interactive |
5368 |
|
(when (and allout-passphrase-hint-handling |
5369 |
|
(not (equal allout-passphrase-hint-handling 'disabled))) |
5370 |
|
(setq new-hint |
5371 |
|
(read-from-minibuffer "Passphrase hint to jog your memory: " |
5372 |
|
allout-passphrase-hint-string)) |
5373 |
|
(when (not (string= new-hint allout-passphrase-hint-string)) |
5374 |
|
(setq allout-passphrase-hint-string new-hint) |
5375 |
|
(allout-adjust-file-variable "allout-passphrase-hint-string" |
5376 |
|
allout-passphrase-hint-string))) |
5377 |
|
(when allout-passphrase-verifier-handling |
5378 |
|
(setq allout-passphrase-verifier-string new-verifier-string) |
5379 |
|
(allout-adjust-file-variable "allout-passphrase-verifier-string" |
5380 |
|
allout-passphrase-verifier-string)) |
5381 |
|
) |
5382 |
) |
) |
5383 |
) |
) |
5384 |
;;;_ > allout-get-encryption-key-verifier () |
;;;_ > allout-get-encryption-passphrase-verifier () |
5385 |
(defun allout-get-encryption-key-verifier () |
(defun allout-get-encryption-passphrase-verifier () |
5386 |
"Return the text of the encrypt key verifier, unmassaged, or nil if none. |
"Return text of the encrypt passphrase verifier, unmassaged, or nil if none. |
5387 |
|
|
5388 |
Derived from value of `allout-file-key-verifier-string'." |
Derived from value of `allout-file-passphrase-verifier-string'." |
5389 |
|
|
5390 |
(let ((verifier-string (and (boundp 'allout-key-verifier-string) |
(let ((verifier-string (and (boundp 'allout-passphrase-verifier-string) |
5391 |
allout-key-verifier-string))) |
allout-passphrase-verifier-string))) |
5392 |
(if verifier-string |
(if verifier-string |
5393 |
;; Return it uncollapsed |
;; Return it uncollapsed |
5394 |
(subst-char-in-string ?\C-a ?\n verifier-string) |
(subst-char-in-string ?\C-a ?\n verifier-string)) |
|
nil) |
|
5395 |
) |
) |
5396 |
) |
) |
5397 |
;;;_ > allout-verify-key (key) |
;;;_ > allout-verify-passphrase (key passphrase allout-buffer) |
5398 |
(defun allout-verify-key (key allout-buffer) |
(defun allout-verify-passphrase (key passphrase allout-buffer) |
5399 |
"True if key successfully decrypts key verifier, nil otherwise. |
"True if passphrase successfully decrypts verifier, nil otherwise. |
5400 |
|
|
5401 |
\"Otherwise\" includes absence of key verifier." |
\"Otherwise\" includes absence of passphrase verifier." |
5402 |
(save-excursion |
(save-excursion |
5403 |
(set-buffer allout-buffer) |
(set-buffer allout-buffer) |
5404 |
(and (boundp 'allout-key-verifier-string) |
(and (boundp 'allout-passphrase-verifier-string) |
5405 |
allout-key-verifier-string |
allout-passphrase-verifier-string |
5406 |
(allout-encrypt-string (allout-get-encryption-key-verifier) |
(allout-encrypt-string (allout-get-encryption-passphrase-verifier) |
5407 |
'decrypt allout-buffer 'symmetric |
'decrypt allout-buffer 'symmetric |
5408 |
nil nil 'verifying) |
key nil 0 'verifying passphrase) |
5409 |
t))) |
t))) |
5410 |
;;;_ > allout-next-topic-pending-encryption (&optional except-mark) |
;;;_ > allout-next-topic-pending-encryption (&optional except-mark) |
5411 |
(defun allout-next-topic-pending-encryption (&optional except-mark) |
(defun allout-next-topic-pending-encryption (&optional except-mark) |
5521 |
(exchange-point-and-mark)) |
(exchange-point-and-mark)) |
5522 |
;;;_ > outlineify-sticky () |
;;;_ > outlineify-sticky () |
5523 |
;; outlinify-sticky is correct spelling; provide this alias for sticklers: |
;; outlinify-sticky is correct spelling; provide this alias for sticklers: |
5524 |
|
;;;###autoload |
5525 |
(defalias 'outlinify-sticky 'outlineify-sticky) |
(defalias 'outlinify-sticky 'outlineify-sticky) |
5526 |
|
;;;###autoload |
5527 |
(defun outlineify-sticky (&optional arg) |
(defun outlineify-sticky (&optional arg) |
5528 |
"Activate outline mode and establish file var so it is started subsequently. |
"Activate outline mode and establish file var so it is started subsequently. |
5529 |
|
|
5722 |
(if (eq (aref newstr i) fromchar) |
(if (eq (aref newstr i) fromchar) |
5723 |
(aset newstr i tochar))) |
(aset newstr i tochar))) |
5724 |
newstr))) |
newstr))) |
|
|
|
5725 |
;;;_ : my-mark-marker to accommodate divergent emacsen: |
;;;_ : my-mark-marker to accommodate divergent emacsen: |
5726 |
(defun my-mark-marker (&optional force buffer) |
(defun my-mark-marker (&optional force buffer) |
5727 |
"Accommodate the different signature for `mark-marker' across Emacsen. |
"Accommodate the different signature for `mark-marker' across Emacsen. |
5728 |
|
|
5729 |
XEmacs takes two optional args, while mainline GNU Emacs does not, |
XEmacs takes two optional args, while mainline GNU Emacs does not, |
5730 |
so pass them along when appropriate." |
so pass them along when appropriate." |
5731 |
(if (string-match " XEmacs " emacs-version) |
(if (featurep 'xemacs) |
5732 |
(mark-marker force buffer) |
(apply 'mark-marker force buffer) |
5733 |
(mark-marker))) |
(mark-marker))) |
5734 |
|
|
5735 |
;;;_ #10 Under development |
;;;_ #10 Under development |