--- 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 "address@hidden" - 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 "address@hidden" + 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.