From: "Ken Manheimer" <ken.manheimer@gmail.com>
Subject: allout revision
Date: Sat, 29 Jul 2006 19:49:29 -0400 [thread overview]
Message-ID: <2cd46e7f0607291649x196e7745h6a8e019c318bef5d@mail.gmail.com> (raw)
[-- Attachment #1: Type: text/plain, Size: 3763 bytes --]
here's another allout.el update. this fixes some navigation and
encryption passphrase errors, runs the mode activation hook at a more
suitable time, adds a mode deactivation hook, and provides a set of
outline structure-edit hooks analogous to (a refined)
allout-exposure-change-hook.
the contingent of hooks will enable people to build allout
enhancements that cooperate with the existing code, rather than
needing to change it. (i happen to be building such an enhancement,
and it's working out very well. once you find your way, emacs is a
quite nice platform, and it's getting nicer - i love v22.)
the change log is below and attached. i also attached a new copy of
the NEWS file including the new significant facts, as well as the
patch.
2006-07-18 Ken Manheimer <ken.manheimer@gmail.com>
* allout.el (allout-prior-bindings, allout-added-bindings):
Remove, after long deprecation.
(allout-add-resumptions): Add optional qualifier for extending or
appending to existing values, rather than replacing them.
(allout-view-change-hook): Clarify docstring.
(allout-exposure-change-hook): Take explicit arguments, via
run-hook-with-args.
(allout-structure-added-hook)
(allout-structure-deleted-hook)
(allout-structure-shifted-hook): New hooks analogous to
allout-exposure-change-hook for other kinds of structural outline
edits.
(allout-encryption-plaintext-sanitization-regexps): New encryption
customization variable, by which cooperating modes can provde
massage of the plaintext without actually being passed it.
(allout-encryption-ciphertext-rejection-regexps)
(allout-encryption-ciphertext-rejection-ceiling): New encryption
customization variables, by which cooperating modes can prohibit
rare but possible ciphertext patterns from fouling their
operation, with actually being passed the ciphertext.
(allout-mode): Run activation and deactivation hooks after the
minor-mode variable has been toggled, to clarify the mode
disposition. The new encryption ciphertext rejection variable is
used to ensure that the ciphertext does not contain text that
would be recognized as outline structural elements by allout.
(allout-chart-subtree): Implement new mode, charting only the
visible items in the subtree, when new 'visible' parameter is
non-nil.
(allout-end-of-subtree): Properly handle the last item in the
buffer.
(allout-pre-command-business, allout-command-counter): Increment
an advertised counter so that cooperating enhancements can track
revisions of items.
(allout-open-topic): Run allout-structure-added-hook with suitable
arguments.
(allout-shift-in): Run allout-structure-shifted-hook with suitable
arguments.
(allout-shift-out): Fix doubling for negative args and ensure call
of allout-structure-shifted-hook by solely using allout-shift-in.
(allout-kill-line, allout-kill-topic): Run
allout-structure-deleted-hook with suitable arguments.
(allout-flag-region): Run allout-exposure-change-hook with
suitable arguments, instead of making the callee infer the
arguments.
(allout-encrypt-string): Support
allout-encryption-plaintext-sanitization-regexps,
allout-encryption-ciphertext-rejection-regexps, and
allout-encryption-ciphertext-rejection-ceiling. Indicate correct
en/de cryption mode in symmetric encryption failure message.
(allout-obtain-passphrase): Use copy-sequence to get a distinct
copy of the passphrase, and don't zero it or we'll corrupt the
stashed copy.
(allout-create-encryption-passphrase-verifier)
(allout-verify-passphrase): Respect the new signature for
allout-encrypt-string.
(allout-get-configvar-values): Convenience for getting a
configuration variable value and handling its absence gracefully.
--
ken
ken.manheimer@gmail.com
http://myriadicity.net
[-- Attachment #2: allout-patch.txt --]
[-- Type: text/plain, Size: 33122 bytes --]
--- allout.el 21 Jul 2006 04:26:24 -0400 1.80
+++ allout.el 29 Jul 2006 19:18:32 -0400
@@ -965,16 +965,6 @@
(car (cdr cell)))))))
keymap-list)
map))
-;;;_ = allout-prior-bindings - being deprecated.
-(defvar allout-prior-bindings nil
- "Variable for use in V18, with allout-added-bindings, for
-resurrecting, on mode deactivation, bindings that existed before
-activation. Being deprecated.")
-;;;_ = allout-added-bindings - being deprecated
-(defvar allout-added-bindings nil
- "Variable for use in V18, with allout-prior-bindings, for
-resurrecting, on mode deactivation, bindings that existed before
-activation. Being deprecated.")
;;;_ : Menu bar
(defvar allout-mode-exposure-menu)
(defvar allout-mode-editing-menu)
@@ -1050,43 +1040,65 @@
(make-variable-buffer-local 'allout-mode-prior-settings)
;;;_ > allout-add-resumptions (&rest pairs)
(defun allout-add-resumptions (&rest pairs)
- "Set name/value pairs.
+ "Set name/value PAIRS.
Old settings are preserved for later resumption using `allout-do-resumptions'.
-The pairs are lists whose car is the name of the variable and car of the
-cdr is the new value: '(some-var some-value)'.
-
-The new value is set as a buffer local.
+The new values are set as a buffer local. On resumption, the prior buffer
+scope of the variable is restored along with its value. If it was a void
+buffer-local value, then it is left as nil on resumption.
-If the variable was not previously buffer-local, then that is noted and the
-`allout-do-resumptions' will just `kill-local-variable' of that binding.
+The pairs are lists whose car is the name of the variable and car of the
+cdr is the new value: '(some-var some-value)'. The pairs can actually be
+triples, where the third element qualifies the disposition of the setting,
+as described further below.
+
+If the optional third element is the symbol 'extend, then the new value
+created by `cons'ing the second element of the pair onto the front of the
+existing value.
+
+If the optional third element is the symbol 'append, then the new value is
+extended from the existing one by `append'ing a list containing the second
+element of the pair onto the end of the existing value.
-If it previously was buffer-local, the old value is noted and resurrected
-by `allout-do-resumptions'. \(If the local value was previously void, then
-it is left as nil on resumption.\)
+Extension, and resumptions in general, should not be used for hook
+functions - use the 'local mode of `add-hook' for that, instead.
The settings are stored on `allout-mode-prior-settings'."
(while pairs
(let* ((pair (pop pairs))
(name (car pair))
- (value (cadr pair)))
+ (value (cadr pair))
+ (qualifier (if (> (length pair) 2)
+ (caddr pair)))
+ prior-value)
(if (not (symbolp name))
(error "Pair's name, %S, must be a symbol, not %s"
name (type-of name)))
+ (setq prior-value (condition-case err
+ (symbol-value name)
+ (void-variable nil)))
(when (not (assoc name allout-mode-prior-settings))
;; Not already added as a resumption, create the prior setting entry.
(if (local-variable-p name)
;; is already local variable - preserve the prior value:
- (push (list name (condition-case err
- (symbol-value name)
- (void-variable nil)))
- allout-mode-prior-settings)
+ (push (list name prior-value) allout-mode-prior-settings)
;; wasn't local variable, indicate so for resumption by killing
;; local value, and make it local:
(push (list name) allout-mode-prior-settings)
(make-local-variable name)))
- (set name value))))
+ (if qualifier
+ (cond ((eq qualifier 'extend)
+ (if (not (listp prior-value))
+ (error "extension of non-list prior value attempted")
+ (set name (cons value prior-value))))
+ ((eq qualifier 'append)
+ (if (not (listp prior-value))
+ (error "appending of non-list prior value attempted")
+ (set name (append prior-value (list value)))))
+ (t (error "unrecognized setting qualifier `%s' encountered"
+ qualifier)))
+ (set name value)))))
;;;_ > allout-do-resumptions ()
(defun allout-do-resumptions ()
"Resume all name/value settings registered by `allout-add-resumptions'.
@@ -1121,18 +1133,67 @@
"Symbol for use as allout invisible-text overlay category.")
;;;_ x allout-view-change-hook
(defvar allout-view-change-hook nil
- "*\(Deprecated\) Hook that's run after allout outline exposure changes.
+ "*\(Deprecated\) A hook run after allout outline exposure changes.
-Switch to using `allout-exposure-change-hook' instead. Both
-variables are currently respected, but this one will be ignored
-in a subsequent allout version.")
+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 exposure changes.
+ "*Hook that's run after allout outline subtree exposure changes.
+
+It is run at the conclusion of `allout-flag-region'.
+
+Functions on the hook must take three arguments:
+
+ - from - integer indicating the point at the start of the change.
+ - 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.")
+;;;_ = allout-structure-added-hook
+(defvar allout-structure-added-hook nil
+ "*Hook that's run after addition of items to the outline.
+
+Functions on the hook should take two arguments:
+
+ - new-start - integer indicating the point at the start of the first new item.
+ - new-end - integer indicating the point of the 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 variable will replace `allout-view-change-hook' in a subsequent allout
-version, though both are currently respected.")
+This hook might be invoked multiple times by a single command.")
+;;;_ = allout-structure-deleted-hook
+(defvar allout-structure-deleted-hook nil
+ "*Hook that's run after disciplined deletion of subtrees from the outline.
+Functions on the hook must take two arguments:
+
+ - depth - integer indicating the depth of the subtree that was deleted.
+ - removed-from - integer indicating the point where the subtree was removed.
+
+Some edits that remove or invalidate 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-shifted-hook
+(defvar allout-structure-shifted-hook nil
+ "*Hook that's run after shifting of items in the outline.
+
+Functions on the hook should take two arguments:
+
+ - depth-change - integer indicating depth increase, negative for decrease
+ - start - integer indicating the start point of the shifted parent item.
+
+Some edits that shift items can be 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-outside-normal-auto-fill-function
(defvar allout-outside-normal-auto-fill-function nil
"Value of normal-auto-fill-function outside of allout mode.
@@ -1186,6 +1247,42 @@
This is used to decrypt the topic that was currently being edited, if it
was encrypted automatically as part of a file write or autosave.")
(make-variable-buffer-local 'allout-after-save-decrypt)
+;;;_ = allout-encryption-plaintext-sanitization-regexps
+(defvar allout-encryption-plaintext-sanitization-regexps nil
+ "List of regexps whose matches are removed from plaintext before encryption.
+
+This is for the sake of removing artifacts, like escapes, that are added on
+and not actually part of the original plaintext. The removal is done just
+prior to encryption.
+
+Entries must be symbols that are bound to the desired values.
+
+Each value can be a regexp or a list with a regexp followed by a
+substitution string. If it's just a regexp, all its matches are removed
+before the text is encrypted. If it's a regexp and a substitution, the
+substition is used against the regexp matches, a la `replace-match'.")
+(make-variable-buffer-local 'allout-encryption-text-removal-regexps)
+;;;_ = allout-encryption-ciphertext-rejection-regexps
+(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.
+
+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.")
+
+(make-variable-buffer-local 'allout-encryption-ciphertext-rejection-regexps)
+;;;_ = allout-encryption-ciphertext-rejection-ceiling
+(defvar allout-encryption-ciphertext-rejection-ceiling 5
+ "Limit on number of times encryption ciphertext is rejected.
+
+See `allout-encryption-ciphertext-rejection-regexps' for rejection reasons.")
+(make-variable-buffer-local 'allout-encryption-ciphertext-rejection-ceiling)
;;;_ > allout-mode-p ()
;; Must define this macro above any uses, or byte compilation will lack
;; proper def, if file isn't loaded - eg, during emacs build!
@@ -1637,8 +1734,8 @@
(remove-overlays (point-min) (point-max)
'category 'allout-exposure-category)
- (run-hooks 'allout-mode-deactivate-hook)
- (setq allout-mode nil))
+ (setq allout-mode nil)
+ (run-hooks 'allout-mode-deactivate-hook))
;; Activation:
((not active)
@@ -1654,6 +1751,13 @@
(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:
(setq allout-mode-map
@@ -1717,8 +1821,8 @@
(if allout-layout
(setq do-layout t))
- (run-hooks 'allout-mode-hook)
- (setq allout-mode t))
+ (setq allout-mode t)
+ (run-hooks 'allout-mode-hook))
;; Reactivation:
((setq do-layout t)
@@ -2108,13 +2212,17 @@
;;; for assessment or adjustment of the subtree, without redundant
;;; traversal of the structure.
-;;;_ > allout-chart-subtree (&optional levels orig-depth prev-depth)
-(defun allout-chart-subtree (&optional levels orig-depth prev-depth)
+;;;_ > allout-chart-subtree (&optional levels visible orig-depth prev-depth)
+(defun allout-chart-subtree (&optional levels visible orig-depth prev-depth)
"Produce a location \"chart\" of subtopics of the containing topic.
Optional argument LEVELS specifies the depth \(relative to start
-depth) for the chart. Subsequent optional args are not for public
-use.
+depth) for the chart.
+
+When optional argument VISIBLE is non-nil, the chart includes
+only the visible subelements of the charted subjects.
+
+The remaining optional args are not for internal use by the function.
Point is left at the end of the subtree.
@@ -2141,7 +2249,9 @@
; position to first offspring:
(progn (setq orig-depth (allout-depth))
(or prev-depth (setq prev-depth (1+ orig-depth)))
- (allout-next-heading)))
+ (if visible
+ (allout-next-visible-heading 1)
+ (allout-next-heading))))
;; Loop over the current levels' siblings. Besides being more
;; efficient than tail-recursing over a level, it avoids exceeding
@@ -2163,8 +2273,12 @@
;; next heading at lesser depth:
(while (and (<= curr-depth
(allout-recent-depth))
- (allout-next-heading))))
- (allout-next-heading)))
+ (if visible
+ (allout-next-visible-heading 1)
+ (allout-next-heading)))))
+ (if visible
+ (allout-next-visible-heading 1)
+ (allout-next-heading))))
((and (< prev-depth curr-depth)
(or (not levels)
@@ -2173,8 +2287,9 @@
(setq chart
(cons (allout-chart-subtree (and levels
(1- levels))
- orig-depth
- curr-depth)
+ visible
+ orig-depth
+ curr-depth)
chart))
;; ... then continue with this one.
)
@@ -2369,7 +2484,9 @@
(while (and (not (eobp))
(> (allout-recent-depth) level))
(allout-next-heading))
- (and (not (eobp)) (forward-char -1))
+ (if (eobp)
+ (allout-end-of-entry)
+ (forward-char -1))
(if (and (not include-trailing-blank) (= ?\n (preceding-char)))
(forward-char -1))
(setq allout-recent-end-of-subtree (point))))
@@ -2675,6 +2792,13 @@
are mapped to the command of the corresponding control-key on the
`allout-mode-map'.")
(make-variable-buffer-local 'allout-post-goto-bullet)
+;;;_ = allout-command-counter
+(defvar allout-command-counter 0
+ "Counter that monotonically increases in allout-mode buffers.
+
+Set by `allout-pre-command-business', to support allout addons in
+coordinating with allout activity.")
+(make-variable-buffer-local 'allout-command-counter)
;;;_ > allout-post-command-business ()
(defun allout-post-command-business ()
"Outline `post-command-hook' function.
@@ -2692,7 +2816,7 @@
allout-after-save-decrypt)
(allout-after-saves-handler))
- ;; Implement -post-goto-bullet, if set:
+ ;; Implement allout-post-goto-bullet, if set:
(if (and allout-post-goto-bullet
(allout-current-bullet-pos))
(progn (goto-char (allout-current-bullet-pos))
@@ -2701,7 +2825,9 @@
;;;_ > allout-pre-command-business ()
(defun allout-pre-command-business ()
"Outline `pre-command-hook' function for outline buffers.
-Implements special behavior when cursor is on bullet character.
+
+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
@@ -2709,7 +2835,7 @@
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
+The upshot is that you can get easy, single \(ie, unmodified\) key
outline maneuvering operations by positioning the cursor on the bullet
char. When in this mode you can use regular cursor-positioning
command/keystrokes to relocate the cursor off of a bullet character to
@@ -2717,6 +2843,9 @@
(if (not (allout-mode-p))
nil
+ ;; Increment allout-command-counter
+ (setq allout-command-counter (1+ allout-command-counter))
+ ;; Do hot-spot navigation.
(if (and (eq this-command 'self-insert-command)
(eq (point)(allout-current-bullet-pos)))
(allout-hotspot-key-handler))))
@@ -2990,6 +3119,8 @@
If OFFER-RECENT-BULLET is true, offer to use the bullet of the prior sibling.
+Runs
+
Nuances:
- Creation of new topics is with respect to the visible topic
@@ -3040,7 +3171,8 @@
allout-numbered-bullet))))
(point)))
dbl-space
- doing-beginning)
+ doing-beginning
+ start end)
(if (not opening-on-blank)
; Positioning and vertical
@@ -3141,8 +3273,10 @@
(not (bolp)))
(forward-char 1))))
))
+ (setq start (point))
(insert (concat (allout-make-topic-prefix opening-numbered t depth)
" "))
+ (setq end (1+ (point)))
(allout-rebullet-heading (and offer-recent-bullet ref-bullet)
depth nil nil t)
@@ -3150,6 +3284,8 @@
(save-excursion (goto-char ref-topic)
(allout-show-children)))
(end-of-line)
+
+ (run-hook-with-args 'allout-structure-added-hook start end)
)
)
;;;_ > allout-open-subtopic (arg)
@@ -3564,7 +3700,13 @@
(1+ predecessor-depth)))
(error (concat "Disallowed shift deeper than"
" containing topic's children.")))))))
- (allout-rebullet-topic arg))
+ (let ((where (point)))
+ (allout-rebullet-topic arg)
+ (if (> arg 0)
+ (save-excursion
+ (if (allout-ascend)
+ (allout-show-children))))
+ (run-hook-with-args 'allout-structure-shifted-hook arg where)))
;;;_ > allout-shift-out (arg)
(defun allout-shift-out (arg)
"Decrease depth of current heading and any topics collapsed within it.
@@ -3574,9 +3716,7 @@
discontinuity. The first topic in the file can be adjusted to any positive
depth, however."
(interactive "p")
- (if (< arg 0)
- (allout-shift-in (* arg -1)))
- (allout-rebullet-topic (* arg -1)))
+ (allout-shift-in (* arg -1)))
;;;_ : Surgery (kill-ring) functions with special provisions for outlines:
;;;_ > allout-kill-line (&optional arg)
(defun allout-kill-line (&optional arg)
@@ -3610,7 +3750,8 @@
(save-excursion ; Renumber subsequent topics if needed:
(if (not (looking-at allout-regexp))
(allout-next-heading))
- (allout-renumber-to-depth depth))))))
+ (allout-renumber-to-depth depth)))
+ (run-hook-with-args 'allout-structure-deleted-hook depth (point)))))
;;;_ > allout-kill-topic ()
(defun allout-kill-topic ()
"Kill topic together with subtopics.
@@ -3656,7 +3797,8 @@
(allout-unprotected (kill-region beg (point)))
(sit-for 0)
(save-excursion
- (allout-renumber-to-depth depth))))
+ (allout-renumber-to-depth depth))
+ (run-hook-with-args 'allout-structure-deleted-hook depth (point))))
;;;_ > allout-yank-processing ()
(defun allout-yank-processing (&optional arg)
@@ -3882,9 +4024,13 @@
;;;_ - Fundamental
;;;_ > allout-flag-region (from to flag)
(defun allout-flag-region (from to flag)
- "Conceal text from FROM to TO if FLAG is non-nil, else reveal it.
+ "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.\)"
-Text is shown if flag is nil and hidden otherwise."
;; We use outline invisibility spec.
(remove-overlays from to 'category 'allout-exposure-category)
(when flag
@@ -3895,7 +4041,7 @@
(while props
(overlay-put o (pop props) (pop props)))))))
(run-hooks 'allout-view-change-hook)
- (run-hooks 'allout-exposure-change-hook))
+ (run-hook-with-args 'allout-exposure-change-hook from to flag))
;;;_ > allout-flag-current-subtree (flag)
(defun allout-flag-current-subtree (flag)
"Conceal currently-visible topic's subtree if FLAG non-nil, else reveal it."
@@ -4071,10 +4217,12 @@
default, they are treated as being uncollapsed."
(save-excursion
(and
- (= (progn (allout-back-to-current-heading)
- (move-end-of-line 1)
- (point))
- (allout-end-of-current-subtree (not (looking-at "\n\n"))))
+ ;; Is the topic all on one line (allowing for trailing blank line)?
+ (>= (progn (allout-back-to-current-heading)
+ (move-end-of-line 1)
+ (point))
+ (allout-end-of-current-subtree (not (looking-at "\n\n"))))
+
(or include-single-liners
(progn (backward-char 1) (allout-hidden-p))))))
;;;_ > allout-hide-current-subtree (&optional just-close)
@@ -5097,8 +5245,8 @@
;;; fetch-pass &optional retried verifying
;;; passphrase)
(defun allout-encrypt-string (text decrypt allout-buffer key-type for-key
- fetch-pass &optional retried verifying
- passphrase)
+ fetch-pass &optional retried rejected
+ verifying passphrase)
"Encrypt or decrypt message TEXT.
If DECRYPT is true (default false), then decrypt instead of encrypt.
@@ -5116,6 +5264,11 @@
Optional PASSPHRASE enables explicit delivery of the decryption passphrase,
for verification purposes.
+Optional REJECTED is for internal use - conveys 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)
@@ -5141,6 +5294,17 @@
target-prompt-id
(or (buffer-file-name allout-buffer)
target-prompt-id))))
+ (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)))
+ (rejected (or rejected 0))
+ (rejections-left (- allout-encryption-ciphertext-rejection-ceiling
+ rejected))
result-text status)
(if (and fetch-pass (not passphrase))
@@ -5161,10 +5325,19 @@
key-type
allout-buffer
retried fetch-pass)))
+
(with-temp-buffer
(insert text)
+ (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))
+ (while (re-search-forward re nil t)
+ (replace-match replacement nil nil)))))
+
(cond
;; symmetric:
@@ -5183,7 +5356,8 @@
(if verifying
(throw 'encryption-failed nil)
(pgg-remove-passphrase-from-cache target-cache-id t)
- (error "Symmetric-cipher encryption failed - %s"
+ (error "Symmetric-cipher %scryption failed - %s"
+ (if decrypt "de" "en")
"try again with different passphrase."))))
;; encrypt 'keypair:
@@ -5208,48 +5382,68 @@
(if status
(pgg-situate-output (point-min) (point-max))
(error (pgg-remove-passphrase-from-cache target-cache-id t)
- (error "decryption failed"))))
- )
+ (error "decryption failed")))))
(setq result-text
(buffer-substring 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 allout-buffer decrypt nil
- (if retried (1+ retried) 1)
- 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 unusable"
- " non-armored text - 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)
- )
)
+
+ ;; 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)
+ )
)
)
)
@@ -5313,7 +5507,6 @@
(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)
@@ -5321,14 +5514,14 @@
;; Duplicate our handle on the passphrase so it's not clobbered by
;; deactivate-passwd memory clearing:
- (setq got-pass (format "%s" got-pass))
+ (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 'verifying
- got-pass)
+ for-key nil 0 0 'verifying
+ (copy-sequence got-pass))
(setq confirmation (format "%s" got-pass))))
(if (and (not confirmation)
@@ -5365,15 +5558,7 @@
;; recurse to this routine:
(pgg-read-passphrase prompt-sans-hint cache-id t))
(pgg-remove-passphrase-from-cache cache-id t)
- (error "Confirmation failed.")))
- ;; reduce opportunity for memory cherry-picking by zeroing duplicate:
- (dotimes (i (length got-pass))
- (aset got-pass i 0))
- )
- )
- )
- )
- )
+ (error "Confirmation failed."))))))))
;;;_ > allout-encrypted-topic-p ()
(defun allout-encrypted-topic-p ()
"True if the current topic is encryptable and encrypted."
@@ -5426,7 +5611,7 @@
(dotimes (i (length spew))
(aset spew i (1+ (random 254))))
(allout-encrypt-string spew nil (current-buffer) 'symmetric
- nil nil 0 passphrase))
+ nil nil 0 0 passphrase))
)
;;;_ > allout-update-passphrase-mnemonic-aids (for-key passphrase
;;; outline-buffer)
@@ -5505,7 +5690,7 @@
allout-passphrase-verifier-string
(allout-encrypt-string (allout-get-encryption-passphrase-verifier)
'decrypt allout-buffer 'symmetric
- key nil 0 'verifying passphrase)
+ key nil 0 0 'verifying passphrase)
t)))
;;;_ > allout-next-topic-pending-encryption (&optional except-mark)
(defun allout-next-topic-pending-encryption (&optional except-mark)
@@ -5808,6 +5993,25 @@
(goto-char (1+ (match-beginning 0)))
(setq count (1+ count)))
count))))
+;;;_ > allout-get-configvar-values (varname)
+(defun allout-get-configvar-values (configvar-name)
+ "Return a list of values of the symbols in list bound to CONFIGVAR-NAME.
+
+The user is prompted for removal of symbols that are unbound, and they
+otherwise are ignored.
+
+CONFIGVAR-NAME should be the name of the configuration variable,
+not its value."
+
+ (let ((configvar-value (symbol-value configvar-name))
+ got)
+ (dolist (sym configvar-value)
+ (if (not (boundp sym))
+ (if (yes-or-no-p (format "%s entry `%s' is unbound - remove it? "
+ configvar-name sym))
+ (delq sym (symbol-value configvar-name)))
+ (push (symbol-value sym) got)))
+ (reverse got)))
;;;_ > allout-mark-marker to accommodate divergent emacsen:
(defun allout-mark-marker (&optional force buffer)
"Accommodate the different signature for `mark-marker' across Emacsen.
[-- Attachment #3: ChangeLog-entry.txt --]
[-- Type: text/plain, Size: 2957 bytes --]
2006-07-18 Ken Manheimer <ken.manheimer@gmail.com>
* allout.el (allout-prior-bindings, allout-added-bindings):
Remove, after long deprecation.
(allout-add-resumptions): Add optional qualifier for extending or
appending to existing values, rather than replacing them.
(allout-view-change-hook): Clarify docstring.
(allout-exposure-change-hook): Take explicit arguments, via
run-hook-with-args.
(allout-structure-added-hook)
(allout-structure-deleted-hook)
(allout-structure-shifted-hook): New hooks analogous to
allout-exposure-change-hook for other kinds of structural outline
edits.
(allout-encryption-plaintext-sanitization-regexps): New encryption
customization variable, by which cooperating modes can provde
massage of the plaintext without actually being passed it.
(allout-encryption-ciphertext-rejection-regexps)
(allout-encryption-ciphertext-rejection-ceiling): New encryption
customization variables, by which cooperating modes can prohibit
rare but possible ciphertext patterns from fouling their
operation, with actually being passed the ciphertext.
(allout-mode): Run activation and deactivation hooks after the
minor-mode variable has been toggled, to clarify the mode
disposition. The new encryption ciphertext rejection variable is
used to ensure that the ciphertext does not contain text that
would be recognized as outline structural elements by allout.
(allout-chart-subtree): Implement new mode, charting only the
visible items in the subtree, when new 'visible' parameter is
non-nil.
(allout-end-of-subtree): Properly handle the last item in the
buffer.
(allout-pre-command-business, allout-command-counter): Increment
and advertised counter so that cooperating enhancements can track
revisions of items.
(allout-open-topic): Run allout-structure-added-hook with suitable
arguments.
(allout-shift-in): Run allout-structure-shifted-hook with suitable
arguments.
(allout-shift-out): Fix doubling for negative args and ensure call
of allout-structure-shifted-hook by solely using allout-shift-in.
(allout-kill-line, allout-kill-topic): Run
allout-structure-deleted-hook with suitable arguments.
(allout-flag-region): Run allout-exposure-change-hook with
suitable arguments, instead of making the callee infer the
arguments.
(allout-encrypt-string): Support
allout-encryption-plaintext-sanitization-regexps,
allout-encryption-ciphertext-rejection-regexps, and
allout-encryption-ciphertext-rejection-ceiling. Indicate correct
en/de cryption mode in symmetric encryption failure message.
(allout-obtain-passphrase): Use copy-sequence to get a distinct
copy of the passphrase, and don't zero it or we'll corrupt the
stashed copy.
(allout-create-encryption-passphrase-verifier)
(allout-verify-passphrase): Respect the new signature for
allout-encrypt-string.
(allout-get-configvar-values): Convenience for getting a
configuration variable value and handling its absence gracefully.
[-- Attachment #4: allout-NEWS.txt --]
[-- Type: text/plain, Size: 3409 bytes --]
** Changes in Allout
*** Topic cryptography added, enabling easy gpg topic encryption and
decryption. Per-topic basis enables interspersing encrypted-text and
clear-text within a single file to your heart's content, using symmetric
and/or public key modes. Time-limited key caching, user-provided
symmetric key hinting and consistency verification, auto-encryption of
pending topics on save, and more, make it easy to use encryption in
powerful ways. Encryption behavior customization is collected in the
allout-encryption customization group.
*** `allout-view-change-hook' marked as being deprecated - use
`allout-exposure-change-hook' instead. Both are still invoked, but
`allout-view-change-hook' will eventually be ignored. The new
`allout-exposure-change-hook' is called with args that were passed to
`allout-flag-region', making it easier to use.
*** Other allout functions which change the outline structure also have
hooks, enabling cooperative allout enhancements. See
`allout-structure-added-hook', `allout-structure-deleted-hook', and
`allout-structure-shifted-hook'.
*** Default command prefix changed to "\C-c " (control-c space), to avoid
intruding on user's keybinding space. Customize the
`allout-command-prefix' variable to your preference.
*** Allout now uses text overlay's `invisible' property (and others) for
concealed text, instead of selective-display. This simplifies the code, in
particular avoiding the need for kludges for isearch dynamic-display,
discretionary handling of edits of concealed text, undo concerns, etc.
*** Many substantial fixes and refinements, including:
- repaired inhibition of inadvertent edits to concealed text
- refuse to create "containment discontinuities", where a
topic is shifted deeper than the offspring-depth of its' container
- auto-fill-mode is now left inactive when allout-mode starts, if it
already was inactive. also, `allout-inhibit-auto-fill' custom
configuration variable makes it easy to disable auto fill in allout
outlines in general or on a per-buffer basis.
- mode hook changes: new hook `allout-mode-deactivate-hook', for
coordinating with deactivation of allout-mode. `allout-mode-hook' is
now run after the `allout-mode' variable is changed, as is the new
`allout-mode-deactivate-hook'.
- allout now tolerates fielded text in outlines without disruption.
- hot-spot navigation now is modularized with a new function,
`allout-hotspot-key-handler', enabling easier articulation and
enhancement of the functionality by allout addons.
- repaired retention of topic body hanging indent upon topic depth shifts
- bulleting variation is simpler and more accommodating, both in the
default behavior and in ability to vary when creating new topics
- mode deactivation now does cleans up effectively, more properly
restoring affected variables and hooks to former state, removing
overlays, etc. see `allout-add-resumptions' and
`allout-do-resumptions', which replace the old `allout-resumptions'.
- included a few unit-tests for interior functionality. developers can
have them automatically run at the end of module load by customizing
the option `allout-run-unit-tests-on-load'.
- many, many minor tweaks and fixes. many internal fixes and
refinements of docstrings.
- version number incremented to 2.2
[-- Attachment #5: Type: text/plain, Size: 142 bytes --]
_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-devel
reply other threads:[~2006-07-29 23:49 UTC|newest]
Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=2cd46e7f0607291649x196e7745h6a8e019c318bef5d@mail.gmail.com \
--to=ken.manheimer@gmail.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.