aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorEli Zaretskii2006-08-12 12:33:32 +0000
committerEli Zaretskii2006-08-12 12:33:32 +0000
commit48bd8440bc61d1d994f6139735270b1e7ca37035 (patch)
tree291c13aca142149a916015696ebaf9a002ea7dc6
parentc97f19653b493b272845daf68798c3e96ad6f3d1 (diff)
downloademacs-48bd8440bc61d1d994f6139735270b1e7ca37035.tar.gz
emacs-48bd8440bc61d1d994f6139735270b1e7ca37035.zip
(allout-prior-bindings, allout-added-bindings): Remove, after long deprecation.
(allout-beginning-of-line-cycles, allout-end-of-line-cycles): Add customization vars controlling allout-beginning-of-line and allout-end-of-line conveniences. (allout-header-prefix, allout-use-mode-specific-leader) (allout-use-mode-specific-leader, allout-mode-leaders): Revised docstrings. (allout-infer-header-lead): Change to be an alias for allout-infer-header-lead-and-primary-bullet. (allout-infer-header-lead-and-primary-bullet): New version of allout-infer-header-lead which assigns the primary bullet to the same as the header lead, when its being changed. (allout-infer-body-reindent): Apply regexp-quote instead of unconditionally prepending "\\", so that all literal allout-header-prefix and allout-primary-bullet strings are properly handled. (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. Substite allout-beginning-of-line and allout-end-of-line for conventionall beginning-of-line and end-of-line bindings. If allout-old-style-prefixes is non-nil, don't nullify it on mode activation! (allout-beginning-of-line): Respect `allout-beginning-of-line-cycles'. (allout-end-of-line): Respect `allout-end-of-line-cycles'. (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-yank-processing): Run allout-structure-added-hook with proper arguments. (allout-yank): Enclose activity in allout-unprotected. (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/decryption 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.
-rw-r--r--lisp/allout.el813
1 files changed, 572 insertions, 241 deletions
diff --git a/lisp/allout.el b/lisp/allout.el
index f1f262c70b7..379f664d092 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -213,15 +213,73 @@ just the header."
213(put 'allout-show-bodies 'safe-local-variable 213(put 'allout-show-bodies 'safe-local-variable
214 (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil))))) 214 (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil)))))
215 215
216;;;_ = allout-beginning-of-line-cycles
217(defcustom allout-beginning-of-line-cycles t
218 "*If non-nil, \\[allout-beginning-of-line] will cycle through smart-placement options.
219
220Cycling only happens on when the command is repeated, not when it
221follows a different command.
222
223Smart-placement means that repeated calls to this function will
224advance as follows:
225
226 - if the cursor is on a non-headline body line and not on the first column:
227 then it goes to the first column
228 - if the cursor is on the first column of a non-headline body line:
229 then it goes to the start of the headline within the item body
230 - if the cursor is on the headline and not the start of the headline:
231 then it goes to the start of the headline
232 - if the cursor is on the start of the headline:
233 then it goes to the bullet character \(for hotspot navigation\)
234 - if the cursor is on the bullet character:
235 then it goes to the first column of that line \(the headline\)
236 - if the cursor is on the first column of the headline:
237 then it goes to the start of the headline within the item body.
238
239In this fashion, you can use the beginning-of-line command to do
240its normal job and then, when repeated, advance through the
241entry, cycling back to start.
242
243If this configuration variable is nil, then the cursor is just
244advanced to the beginning of the line and remains there on
245repeated calls."
246 :type 'boolean :group 'allout)
247;;;_ = allout-end-of-line-cycles
248(defcustom allout-end-of-line-cycles t
249 "*If non-nil, \\[allout-end-of-line] will cycle through smart-placement options.
250
251Cycling only happens on when the command is repeated, not when it
252follows a different command.
253
254Smart-placement means that repeated calls to this function will
255advance as follows:
256
257 - if the cursor is not on the end-of-line,
258 then it goes to the end-of-line
259 - if the cursor is on the end-of-line but not the end-of-entry,
260 then it goes to the end-of-entry, exposing it if necessary
261 - if the cursor is on the end-of-entry,
262 then it goes to the end of the head line
263
264In this fashion, you can use the end-of-line command to do its
265normal job and then, when repeated, advance through the entry,
266cycling back to start.
267
268If this configuration variable is nil, then the cursor is just
269advanced to the end of the line and remains there on repeated
270calls."
271 :type 'boolean :group 'allout)
272
216;;;_ = allout-header-prefix 273;;;_ = allout-header-prefix
217(defcustom allout-header-prefix "." 274(defcustom allout-header-prefix "."
275;; this string is treated as literal match. it will be `regexp-quote'd, so
276;; one cannot use regular expressions to match varying header prefixes.
218 "*Leading string which helps distinguish topic headers. 277 "*Leading string which helps distinguish topic headers.
219 278
220Outline topic header lines are identified by a leading topic 279Outline topic header lines are identified by a leading topic
221header prefix, which mostly have the value of this var at their front. 280header prefix, which mostly have the value of this var at their front.
222\(Level 1 topics are exceptions. They consist of only a single 281Level 1 topics are exceptions. They consist of only a single
223character, which is typically set to the `allout-primary-bullet'. Many 282character, which is typically set to the `allout-primary-bullet'."
224outlines start at level 2 to avoid this discrepancy."
225 :type 'string 283 :type 'string
226 :group 'allout) 284 :group 'allout)
227(make-variable-buffer-local 'allout-header-prefix) 285(make-variable-buffer-local 'allout-header-prefix)
@@ -300,11 +358,13 @@ strings."
300(defcustom allout-use-mode-specific-leader t 358(defcustom allout-use-mode-specific-leader t
301 "*When non-nil, use mode-specific topic-header prefixes. 359 "*When non-nil, use mode-specific topic-header prefixes.
302 360
303Allout outline mode will use the mode-specific `allout-mode-leaders' 361Allout outline mode will use the mode-specific `allout-mode-leaders' or
304and/or comment-start string, if any, to lead the topic prefix string, 362comment-start string, if any, to lead the topic prefix string, so topic
305so topic headers look like comments in the programming language. 363headers look like comments in the programming language. It will also use
364the comment-start string, with an '_' appended, for `allout-primary-bullet'.
306 365
307String values are used as they stand. 366String values are used as literals, not regular expressions, so
367do not escape any regulare-expression characters.
308 368
309Value t means to first check for assoc value in `allout-mode-leaders' 369Value t means to first check for assoc value in `allout-mode-leaders'
310alist, then use comment-start string, if any, then use default \(`.'). 370alist, then use comment-start string, if any, then use default \(`.').
@@ -313,15 +373,17 @@ alist, then use comment-start string, if any, then use default \(`.').
313Set to the symbol for either of `allout-mode-leaders' or 373Set to the symbol for either of `allout-mode-leaders' or
314`comment-start' to use only one of them, respectively. 374`comment-start' to use only one of them, respectively.
315 375
316Value nil means to always use the default \(`.'). 376Value nil means to always use the default \(`.') and leave
317 377`allout-primary-bullet' unaltered.
318comment-start strings that do not end in spaces are tripled, and an 378
319`_' underscore is tacked on the end, to distinguish them from regular 379comment-start strings that do not end in spaces are tripled in
320comment strings. comment-start strings that do end in spaces are not 380the header-prefix, and an `_' underscore is tacked on the end, to
321tripled, but an underscore is substituted for the space. [This 381distinguish them from regular comment strings. comment-start
322presumes that the space is for appearance, not comment syntax. You 382strings that do end in spaces are not tripled, but an underscore
323can use `allout-mode-leaders' to override this behavior, when 383is substituted for the space. [This presumes that the space is
324incorrect.]" 384for appearance, not comment syntax. You can use
385`allout-mode-leaders' to override this behavior, when
386undesired.]"
325 :type '(choice (const t) (const nil) string 387 :type '(choice (const t) (const nil) string
326 (const allout-mode-leaders) 388 (const allout-mode-leaders)
327 (const comment-start)) 389 (const comment-start))
@@ -334,13 +396,14 @@ incorrect.]"
334(defvar allout-mode-leaders '() 396(defvar allout-mode-leaders '()
335 "Specific allout-prefix leading strings per major modes. 397 "Specific allout-prefix leading strings per major modes.
336 398
337Entries will be used instead or in lieu of mode-specific 399Use this if the mode's comment-start string isn't what you
338comment-start strings. See also `allout-use-mode-specific-leader'. 400prefer, or if the mode lacks a comment-start string. See
401`allout-use-mode-specific-leader' for more details.
339 402
340If you're constructing a string that will comment-out outline 403If you're constructing a string that will comment-out outline
341structuring so it can be included in program code, append an extra 404structuring so it can be included in program code, append an extra
342character, like an \"_\" underscore, to distinguish the lead string 405character, like an \"_\" underscore, to distinguish the lead string
343from regular comments that start at bol.") 406from regular comments that start at the beginning-of-line.")
344 407
345;;;_ = allout-old-style-prefixes 408;;;_ = allout-old-style-prefixes
346(defcustom allout-old-style-prefixes nil 409(defcustom allout-old-style-prefixes nil
@@ -828,9 +891,9 @@ language comments. Returns the leading string."
828 (setq allout-reindent-bodies nil) 891 (setq allout-reindent-bodies nil)
829 (allout-reset-header-lead header-lead) 892 (allout-reset-header-lead header-lead)
830 header-lead) 893 header-lead)
831;;;_ > allout-infer-header-lead () 894;;;_ > allout-infer-header-lead-and-primary-bullet ()
832(defun allout-infer-header-lead () 895(defun allout-infer-header-lead-and-primary-bullet ()
833 "Determine appropriate `allout-header-prefix'. 896 "Determine appropriate `allout-header-prefix' and `allout-primary-bullet'.
834 897
835Works according to settings of: 898Works according to settings of:
836 899
@@ -874,10 +937,14 @@ invoking it directly."
874 "_"))))))) 937 "_")))))))
875 (if (not leader) 938 (if (not leader)
876 nil 939 nil
877 (if (string= leader allout-header-prefix) 940 (setq allout-header-prefix leader)
878 nil ; no change, nothing to do. 941 (if (not allout-old-style-prefixes)
879 (setq allout-header-prefix leader) 942 ;; setting allout-primary-bullet makes the top level topics use -
880 allout-header-prefix)))) 943 ;; actually, be - the special prefix:
944 (setq allout-primary-bullet leader))
945 allout-header-prefix)))
946(defalias 'allout-infer-header-lead
947 'allout-infer-header-lead-and-primary-bullet)
881;;;_ > allout-infer-body-reindent () 948;;;_ > allout-infer-body-reindent ()
882(defun allout-infer-body-reindent () 949(defun allout-infer-body-reindent ()
883 "Determine proper setting for `allout-reindent-bodies'. 950 "Determine proper setting for `allout-reindent-bodies'.
@@ -930,13 +997,13 @@ Works with respect to `allout-plain-bullets-string' and
930 (setq allout-plain-bullets-string-len (length allout-plain-bullets-string)) 997 (setq allout-plain-bullets-string-len (length allout-plain-bullets-string))
931 (setq allout-header-subtraction (1- (length allout-header-prefix))) 998 (setq allout-header-subtraction (1- (length allout-header-prefix)))
932 ;; Produce the new allout-regexp: 999 ;; Produce the new allout-regexp:
933 (setq allout-regexp (concat "\\(\\" 1000 (setq allout-regexp (concat "\\("
934 allout-header-prefix 1001 (regexp-quote allout-header-prefix)
935 "[ \t]*[" 1002 "[ \t]*["
936 allout-bullets-string 1003 allout-bullets-string
937 "]\\)\\|\\" 1004 "]\\)\\|"
938 allout-primary-bullet 1005 (regexp-quote allout-primary-bullet)
939 "+\\|\^l")) 1006 "+\\|\^l"))
940 (setq allout-line-boundary-regexp 1007 (setq allout-line-boundary-regexp
941 (concat "\\(\n\\)\\(" allout-regexp "\\)")) 1008 (concat "\\(\n\\)\\(" allout-regexp "\\)"))
942 (setq allout-bob-regexp 1009 (setq allout-bob-regexp
@@ -965,16 +1032,6 @@ See doc string for allout-keybindings-list for format of binding list."
965 (car (cdr cell))))))) 1032 (car (cdr cell)))))))
966 keymap-list) 1033 keymap-list)
967 map)) 1034 map))
968;;;_ = allout-prior-bindings - being deprecated.
969(defvar allout-prior-bindings nil
970 "Variable for use in V18, with allout-added-bindings, for
971resurrecting, on mode deactivation, bindings that existed before
972activation. Being deprecated.")
973;;;_ = allout-added-bindings - being deprecated
974(defvar allout-added-bindings nil
975 "Variable for use in V18, with allout-prior-bindings, for
976resurrecting, on mode deactivation, bindings that existed before
977activation. Being deprecated.")
978;;;_ : Menu bar 1035;;;_ : Menu bar
979(defvar allout-mode-exposure-menu) 1036(defvar allout-mode-exposure-menu)
980(defvar allout-mode-editing-menu) 1037(defvar allout-mode-editing-menu)
@@ -1050,43 +1107,65 @@ See `allout-add-resumptions' and `allout-do-resumptions'.")
1050(make-variable-buffer-local 'allout-mode-prior-settings) 1107(make-variable-buffer-local 'allout-mode-prior-settings)
1051;;;_ > allout-add-resumptions (&rest pairs) 1108;;;_ > allout-add-resumptions (&rest pairs)
1052(defun allout-add-resumptions (&rest pairs) 1109(defun allout-add-resumptions (&rest pairs)
1053 "Set name/value pairs. 1110 "Set name/value PAIRS.
1054 1111
1055Old settings are preserved for later resumption using `allout-do-resumptions'. 1112Old settings are preserved for later resumption using `allout-do-resumptions'.
1056 1113
1114The new values are set as a buffer local. On resumption, the prior buffer
1115scope of the variable is restored along with its value. If it was a void
1116buffer-local value, then it is left as nil on resumption.
1117
1057The pairs are lists whose car is the name of the variable and car of the 1118The pairs are lists whose car is the name of the variable and car of the
1058cdr is the new value: '(some-var some-value)'. 1119cdr is the new value: '(some-var some-value)'. The pairs can actually be
1120triples, where the third element qualifies the disposition of the setting,
1121as described further below.
1059 1122
1060The new value is set as a buffer local. 1123If the optional third element is the symbol 'extend, then the new value
1124created by `cons'ing the second element of the pair onto the front of the
1125existing value.
1061 1126
1062If the variable was not previously buffer-local, then that is noted and the 1127If the optional third element is the symbol 'append, then the new value is
1063`allout-do-resumptions' will just `kill-local-variable' of that binding. 1128extended from the existing one by `append'ing a list containing the second
1129element of the pair onto the end of the existing value.
1064 1130
1065If it previously was buffer-local, the old value is noted and resurrected 1131Extension, and resumptions in general, should not be used for hook
1066by `allout-do-resumptions'. \(If the local value was previously void, then 1132functions - use the 'local mode of `add-hook' for that, instead.
1067it is left as nil on resumption.\)
1068 1133
1069The settings are stored on `allout-mode-prior-settings'." 1134The settings are stored on `allout-mode-prior-settings'."
1070 (while pairs 1135 (while pairs
1071 (let* ((pair (pop pairs)) 1136 (let* ((pair (pop pairs))
1072 (name (car pair)) 1137 (name (car pair))
1073 (value (cadr pair))) 1138 (value (cadr pair))
1139 (qualifier (if (> (length pair) 2)
1140 (caddr pair)))
1141 prior-value)
1074 (if (not (symbolp name)) 1142 (if (not (symbolp name))
1075 (error "Pair's name, %S, must be a symbol, not %s" 1143 (error "Pair's name, %S, must be a symbol, not %s"
1076 name (type-of name))) 1144 name (type-of name)))
1145 (setq prior-value (condition-case err
1146 (symbol-value name)
1147 (void-variable nil)))
1077 (when (not (assoc name allout-mode-prior-settings)) 1148 (when (not (assoc name allout-mode-prior-settings))
1078 ;; Not already added as a resumption, create the prior setting entry. 1149 ;; Not already added as a resumption, create the prior setting entry.
1079 (if (local-variable-p name) 1150 (if (local-variable-p name)
1080 ;; is already local variable - preserve the prior value: 1151 ;; is already local variable - preserve the prior value:
1081 (push (list name (condition-case err 1152 (push (list name prior-value) allout-mode-prior-settings)
1082 (symbol-value name)
1083 (void-variable nil)))
1084 allout-mode-prior-settings)
1085 ;; wasn't local variable, indicate so for resumption by killing 1153 ;; wasn't local variable, indicate so for resumption by killing
1086 ;; local value, and make it local: 1154 ;; local value, and make it local:
1087 (push (list name) allout-mode-prior-settings) 1155 (push (list name) allout-mode-prior-settings)
1088 (make-local-variable name))) 1156 (make-local-variable name)))
1089 (set name value)))) 1157 (if qualifier
1158 (cond ((eq qualifier 'extend)
1159 (if (not (listp prior-value))
1160 (error "extension of non-list prior value attempted")
1161 (set name (cons value prior-value))))
1162 ((eq qualifier 'append)
1163 (if (not (listp prior-value))
1164 (error "appending of non-list prior value attempted")
1165 (set name (append prior-value (list value)))))
1166 (t (error "unrecognized setting qualifier `%s' encountered"
1167 qualifier)))
1168 (set name value)))))
1090;;;_ > allout-do-resumptions () 1169;;;_ > allout-do-resumptions ()
1091(defun allout-do-resumptions () 1170(defun allout-do-resumptions ()
1092 "Resume all name/value settings registered by `allout-add-resumptions'. 1171 "Resume all name/value settings registered by `allout-add-resumptions'.
@@ -1121,18 +1200,67 @@ their settings before allout-mode was started."
1121 "Symbol for use as allout invisible-text overlay category.") 1200 "Symbol for use as allout invisible-text overlay category.")
1122;;;_ x allout-view-change-hook 1201;;;_ x allout-view-change-hook
1123(defvar allout-view-change-hook nil 1202(defvar allout-view-change-hook nil
1124 "*\(Deprecated\) Hook that's run after allout outline exposure changes. 1203 "*\(Deprecated\) A hook run after allout outline exposure changes.
1125 1204
1126Switch to using `allout-exposure-change-hook' instead. Both 1205Switch to using `allout-exposure-change-hook' instead. Both hooks are
1127variables are currently respected, but this one will be ignored 1206currently respected, but the other conveys the details of the exposure
1128in a subsequent allout version.") 1207change via explicit parameters, and this one will eventually be disabled in
1208a subsequent allout version.")
1129;;;_ = allout-exposure-change-hook 1209;;;_ = allout-exposure-change-hook
1130(defvar allout-exposure-change-hook nil 1210(defvar allout-exposure-change-hook nil
1131 "*Hook that's run after allout outline exposure changes. 1211 "*Hook that's run after allout outline subtree exposure changes.
1212
1213It is run at the conclusion of `allout-flag-region'.
1214
1215Functions on the hook must take three arguments:
1216
1217 - from - integer indicating the point at the start of the change.
1218 - to - integer indicating the point of the end of the change.
1219 - flag - change mode: nil for exposure, otherwise concealment.
1220
1221This hook might be invoked multiple times by a single command.
1222
1223This hook is replacing `allout-view-change-hook', which is being deprecated
1224and eventually will not be invoked.")
1225;;;_ = allout-structure-added-hook
1226(defvar allout-structure-added-hook nil
1227 "*Hook that's run after addition of items to the outline.
1228
1229Functions on the hook should take two arguments:
1230
1231 - new-start - integer indicating the point at the start of the first new item.
1232 - new-end - integer indicating the point of the end of the last new item.
1233
1234Some edits that introduce new items may missed by this hook -
1235specifically edits that native allout routines do not control.
1236
1237This hook might be invoked multiple times by a single command.")
1238;;;_ = allout-structure-deleted-hook
1239(defvar allout-structure-deleted-hook nil
1240 "*Hook that's run after disciplined deletion of subtrees from the outline.
1241
1242Functions on the hook must take two arguments:
1243
1244 - depth - integer indicating the depth of the subtree that was deleted.
1245 - removed-from - integer indicating the point where the subtree was removed.
1246
1247Some edits that remove or invalidate items may missed by this hook -
1248specifically edits that native allout routines do not control.
1132 1249
1133This variable will replace `allout-view-change-hook' in a subsequent allout 1250This hook might be invoked multiple times by a single command.")
1134version, though both are currently respected.") 1251;;;_ = allout-structure-shifted-hook
1252(defvar allout-structure-shifted-hook nil
1253 "*Hook that's run after shifting of items in the outline.
1135 1254
1255Functions on the hook should take two arguments:
1256
1257 - depth-change - integer indicating depth increase, negative for decrease
1258 - start - integer indicating the start point of the shifted parent item.
1259
1260Some edits that shift items can be missed by this hook - specifically edits
1261that native allout routines do not control.
1262
1263This hook might be invoked multiple times by a single command.")
1136;;;_ = allout-outside-normal-auto-fill-function 1264;;;_ = allout-outside-normal-auto-fill-function
1137(defvar allout-outside-normal-auto-fill-function nil 1265(defvar allout-outside-normal-auto-fill-function nil
1138 "Value of normal-auto-fill-function outside of allout mode. 1266 "Value of normal-auto-fill-function outside of allout mode.
@@ -1186,6 +1314,42 @@ state, if file variable adjustments are enabled. See
1186This is used to decrypt the topic that was currently being edited, if it 1314This is used to decrypt the topic that was currently being edited, if it
1187was encrypted automatically as part of a file write or autosave.") 1315was encrypted automatically as part of a file write or autosave.")
1188(make-variable-buffer-local 'allout-after-save-decrypt) 1316(make-variable-buffer-local 'allout-after-save-decrypt)
1317;;;_ = allout-encryption-plaintext-sanitization-regexps
1318(defvar allout-encryption-plaintext-sanitization-regexps nil
1319 "List of regexps whose matches are removed from plaintext before encryption.
1320
1321This is for the sake of removing artifacts, like escapes, that are added on
1322and not actually part of the original plaintext. The removal is done just
1323prior to encryption.
1324
1325Entries must be symbols that are bound to the desired values.
1326
1327Each value can be a regexp or a list with a regexp followed by a
1328substitution string. If it's just a regexp, all its matches are removed
1329before the text is encrypted. If it's a regexp and a substitution, the
1330substition is used against the regexp matches, a la `replace-match'.")
1331(make-variable-buffer-local 'allout-encryption-text-removal-regexps)
1332;;;_ = allout-encryption-ciphertext-rejection-regexps
1333(defvar allout-encryption-ciphertext-rejection-regexps nil
1334 "Variable for regexps matching plaintext to remove before encryption.
1335
1336This is for the sake of redoing encryption in cases where the ciphertext
1337incidentally contains strings that would disrupt mode operation -
1338for example, a line that happens to look like an allout-mode topic prefix.
1339
1340Entries must be symbols that are bound to the desired regexp values.
1341
1342The encryption will be retried up to
1343`allout-encryption-ciphertext-rejection-limit' times, after which an error
1344is raised.")
1345
1346(make-variable-buffer-local 'allout-encryption-ciphertext-rejection-regexps)
1347;;;_ = allout-encryption-ciphertext-rejection-ceiling
1348(defvar allout-encryption-ciphertext-rejection-ceiling 5
1349 "Limit on number of times encryption ciphertext is rejected.
1350
1351See `allout-encryption-ciphertext-rejection-regexps' for rejection reasons.")
1352(make-variable-buffer-local 'allout-encryption-ciphertext-rejection-ceiling)
1189;;;_ > allout-mode-p () 1353;;;_ > allout-mode-p ()
1190;; Must define this macro above any uses, or byte compilation will lack 1354;; Must define this macro above any uses, or byte compilation will lack
1191;; proper def, if file isn't loaded - eg, during emacs build! 1355;; proper def, if file isn't loaded - eg, during emacs build!
@@ -1637,16 +1801,15 @@ OPEN: A topic that is not closed, though its offspring or body may be."
1637 (remove-overlays (point-min) (point-max) 1801 (remove-overlays (point-min) (point-max)
1638 'category 'allout-exposure-category) 1802 'category 'allout-exposure-category)
1639 1803
1640 (run-hooks 'allout-mode-deactivate-hook) 1804 (setq allout-mode nil)
1641 (setq allout-mode nil)) 1805 (run-hooks 'allout-mode-deactivate-hook))
1642 1806
1643 ;; Activation: 1807 ;; Activation:
1644 ((not active) 1808 ((not active)
1645 (setq allout-explicitly-deactivated nil) 1809 (setq allout-explicitly-deactivated nil)
1646 (if allout-old-style-prefixes 1810 (if allout-old-style-prefixes
1647 ;; Inhibit all the fancy formatting: 1811 ;; Inhibit all the fancy formatting:
1648 (allout-add-resumptions '((allout-primary-bullet "*") 1812 (allout-add-resumptions '(allout-primary-bullet "*")))
1649 (allout-old-style-prefixes ()))))
1650 1813
1651 (allout-overlay-preparations) ; Doesn't hurt to redo this. 1814 (allout-overlay-preparations) ; Doesn't hurt to redo this.
1652 1815
@@ -1654,15 +1817,28 @@ OPEN: A topic that is not closed, though its offspring or body may be."
1654 (allout-infer-body-reindent) 1817 (allout-infer-body-reindent)
1655 1818
1656 (set-allout-regexp) 1819 (set-allout-regexp)
1820 (allout-add-resumptions
1821 '(allout-encryption-ciphertext-rejection-regexps
1822 allout-line-boundary-regexp
1823 extend)
1824 '(allout-encryption-ciphertext-rejection-regexps
1825 allout-bob-regexp
1826 extend))
1657 1827
1658 ;; Produce map from current version of allout-keybindings-list: 1828 ;; Produce map from current version of allout-keybindings-list:
1659 (setq allout-mode-map 1829 (setq allout-mode-map
1660 (produce-allout-mode-map allout-keybindings-list)) 1830 (produce-allout-mode-map allout-keybindings-list))
1661 (substitute-key-definition 'beginning-of-line 1831 (substitute-key-definition 'beginning-of-line
1662 'move-beginning-of-line 1832 'allout-beginning-of-line
1833 allout-mode-map global-map)
1834 (substitute-key-definition 'move-beginning-of-line
1835 'allout-beginning-of-line
1663 allout-mode-map global-map) 1836 allout-mode-map global-map)
1664 (substitute-key-definition 'end-of-line 1837 (substitute-key-definition 'end-of-line
1665 'move-end-of-line 1838 'allout-end-of-line
1839 allout-mode-map global-map)
1840 (substitute-key-definition 'move-end-of-line
1841 'allout-end-of-line
1666 allout-mode-map global-map) 1842 allout-mode-map global-map)
1667 (produce-allout-mode-menubar-entries) 1843 (produce-allout-mode-menubar-entries)
1668 (fset 'allout-mode-map allout-mode-map) 1844 (fset 'allout-mode-map allout-mode-map)
@@ -1717,8 +1893,8 @@ OPEN: A topic that is not closed, though its offspring or body may be."
1717 (if allout-layout 1893 (if allout-layout
1718 (setq do-layout t)) 1894 (setq do-layout t))
1719 1895
1720 (run-hooks 'allout-mode-hook) 1896 (setq allout-mode t)
1721 (setq allout-mode t)) 1897 (run-hooks 'allout-mode-hook))
1722 1898
1723 ;; Reactivation: 1899 ;; Reactivation:
1724 ((setq do-layout t) 1900 ((setq do-layout t)
@@ -2044,6 +2220,52 @@ Outermost is first."
2044 (while (allout-hidden-p) 2220 (while (allout-hidden-p)
2045 (end-of-line) 2221 (end-of-line)
2046 (if (allout-hidden-p) (forward-char 1))))) 2222 (if (allout-hidden-p) (forward-char 1)))))
2223;;;_ > allout-beginning-of-line ()
2224(defun allout-beginning-of-line ()
2225 "Beginning-of-line with `allout-beginning-of-line-cycles' behavior, if set."
2226
2227 (interactive)
2228
2229 (if (or (not allout-beginning-of-line-cycles)
2230 (not (equal last-command this-command)))
2231 (move-beginning-of-line 1)
2232 (let ((beginning-of-body (save-excursion
2233 (allout-beginning-of-current-entry)
2234 (point))))
2235 (cond ((= (current-column) 0)
2236 (allout-beginning-of-current-entry))
2237 ((< (point) beginning-of-body)
2238 (allout-beginning-of-current-line))
2239 ((= (point) beginning-of-body)
2240 (goto-char (allout-current-bullet-pos)))
2241 (t (allout-beginning-of-current-line)
2242 (if (< (point) beginning-of-body)
2243 ;; we were on the headline after its start:
2244 (allout-beginning-of-current-entry)))))))
2245;;;_ > allout-end-of-line ()
2246(defun allout-end-of-line ()
2247 "End-of-line with `allout-end-of-line-cycles' behavior, if set."
2248
2249 (interactive)
2250
2251 (if (or (not allout-end-of-line-cycles)
2252 (not (equal last-command this-command)))
2253 (allout-end-of-current-line)
2254 (let ((end-of-entry (save-excursion
2255 (allout-end-of-entry)
2256 (point))))
2257 (cond ((not (eolp))
2258 (allout-end-of-current-line))
2259 ((or (allout-hidden-p) (save-excursion
2260 (forward-char -1)
2261 (allout-hidden-p)))
2262 (allout-back-to-current-heading)
2263 (allout-show-current-entry)
2264 (allout-end-of-entry))
2265 ((>= (point) end-of-entry)
2266 (allout-back-to-current-heading)
2267 (allout-end-of-current-line))
2268 (t (allout-end-of-entry))))))
2047;;;_ > allout-next-heading () 2269;;;_ > allout-next-heading ()
2048(defsubst allout-next-heading () 2270(defsubst allout-next-heading ()
2049 "Move to the heading for the topic \(possibly invisible) after this one. 2271 "Move to the heading for the topic \(possibly invisible) after this one.
@@ -2108,13 +2330,17 @@ Return the location of the beginning of the heading, or nil if not found."
2108;;; for assessment or adjustment of the subtree, without redundant 2330;;; for assessment or adjustment of the subtree, without redundant
2109;;; traversal of the structure. 2331;;; traversal of the structure.
2110 2332
2111;;;_ > allout-chart-subtree (&optional levels orig-depth prev-depth) 2333;;;_ > allout-chart-subtree (&optional levels visible orig-depth prev-depth)
2112(defun allout-chart-subtree (&optional levels orig-depth prev-depth) 2334(defun allout-chart-subtree (&optional levels visible orig-depth prev-depth)
2113 "Produce a location \"chart\" of subtopics of the containing topic. 2335 "Produce a location \"chart\" of subtopics of the containing topic.
2114 2336
2115Optional argument LEVELS specifies the depth \(relative to start 2337Optional argument LEVELS specifies the depth \(relative to start
2116depth) for the chart. Subsequent optional args are not for public 2338depth) for the chart.
2117use. 2339
2340When optional argument VISIBLE is non-nil, the chart includes
2341only the visible subelements of the charted subjects.
2342
2343The remaining optional args are not for internal use by the function.
2118 2344
2119Point is left at the end of the subtree. 2345Point is left at the end of the subtree.
2120 2346
@@ -2141,7 +2367,9 @@ starting point, and PREV-DEPTH is depth of prior topic."
2141 ; position to first offspring: 2367 ; position to first offspring:
2142 (progn (setq orig-depth (allout-depth)) 2368 (progn (setq orig-depth (allout-depth))
2143 (or prev-depth (setq prev-depth (1+ orig-depth))) 2369 (or prev-depth (setq prev-depth (1+ orig-depth)))
2144 (allout-next-heading))) 2370 (if visible
2371 (allout-next-visible-heading 1)
2372 (allout-next-heading))))
2145 2373
2146 ;; Loop over the current levels' siblings. Besides being more 2374 ;; Loop over the current levels' siblings. Besides being more
2147 ;; efficient than tail-recursing over a level, it avoids exceeding 2375 ;; efficient than tail-recursing over a level, it avoids exceeding
@@ -2163,8 +2391,12 @@ starting point, and PREV-DEPTH is depth of prior topic."
2163 ;; next heading at lesser depth: 2391 ;; next heading at lesser depth:
2164 (while (and (<= curr-depth 2392 (while (and (<= curr-depth
2165 (allout-recent-depth)) 2393 (allout-recent-depth))
2166 (allout-next-heading)))) 2394 (if visible
2167 (allout-next-heading))) 2395 (allout-next-visible-heading 1)
2396 (allout-next-heading)))))
2397 (if visible
2398 (allout-next-visible-heading 1)
2399 (allout-next-heading))))
2168 2400
2169 ((and (< prev-depth curr-depth) 2401 ((and (< prev-depth curr-depth)
2170 (or (not levels) 2402 (or (not levels)
@@ -2173,8 +2405,9 @@ starting point, and PREV-DEPTH is depth of prior topic."
2173 (setq chart 2405 (setq chart
2174 (cons (allout-chart-subtree (and levels 2406 (cons (allout-chart-subtree (and levels
2175 (1- levels)) 2407 (1- levels))
2176 orig-depth 2408 visible
2177 curr-depth) 2409 orig-depth
2410 curr-depth)
2178 chart)) 2411 chart))
2179 ;; ... then continue with this one. 2412 ;; ... then continue with this one.
2180 ) 2413 )
@@ -2369,7 +2602,9 @@ Returns the value of point."
2369 (while (and (not (eobp)) 2602 (while (and (not (eobp))
2370 (> (allout-recent-depth) level)) 2603 (> (allout-recent-depth) level))
2371 (allout-next-heading)) 2604 (allout-next-heading))
2372 (and (not (eobp)) (forward-char -1)) 2605 (if (eobp)
2606 (allout-end-of-entry)
2607 (forward-char -1))
2373 (if (and (not include-trailing-blank) (= ?\n (preceding-char))) 2608 (if (and (not include-trailing-blank) (= ?\n (preceding-char)))
2374 (forward-char -1)) 2609 (forward-char -1))
2375 (setq allout-recent-end-of-subtree (point)))) 2610 (setq allout-recent-end-of-subtree (point))))
@@ -2675,6 +2910,13 @@ hot-spot operation, where literal characters typed over a topic bullet
2675are mapped to the command of the corresponding control-key on the 2910are mapped to the command of the corresponding control-key on the
2676`allout-mode-map'.") 2911`allout-mode-map'.")
2677(make-variable-buffer-local 'allout-post-goto-bullet) 2912(make-variable-buffer-local 'allout-post-goto-bullet)
2913;;;_ = allout-command-counter
2914(defvar allout-command-counter 0
2915 "Counter that monotonically increases in allout-mode buffers.
2916
2917Set by `allout-pre-command-business', to support allout addons in
2918coordinating with allout activity.")
2919(make-variable-buffer-local 'allout-command-counter)
2678;;;_ > allout-post-command-business () 2920;;;_ > allout-post-command-business ()
2679(defun allout-post-command-business () 2921(defun allout-post-command-business ()
2680 "Outline `post-command-hook' function. 2922 "Outline `post-command-hook' function.
@@ -2692,7 +2934,7 @@ are mapped to the command of the corresponding control-key on the
2692 allout-after-save-decrypt) 2934 allout-after-save-decrypt)
2693 (allout-after-saves-handler)) 2935 (allout-after-saves-handler))
2694 2936
2695 ;; Implement -post-goto-bullet, if set: 2937 ;; Implement allout-post-goto-bullet, if set:
2696 (if (and allout-post-goto-bullet 2938 (if (and allout-post-goto-bullet
2697 (allout-current-bullet-pos)) 2939 (allout-current-bullet-pos))
2698 (progn (goto-char (allout-current-bullet-pos)) 2940 (progn (goto-char (allout-current-bullet-pos))
@@ -2701,7 +2943,9 @@ are mapped to the command of the corresponding control-key on the
2701;;;_ > allout-pre-command-business () 2943;;;_ > allout-pre-command-business ()
2702(defun allout-pre-command-business () 2944(defun allout-pre-command-business ()
2703 "Outline `pre-command-hook' function for outline buffers. 2945 "Outline `pre-command-hook' function for outline buffers.
2704Implements special behavior when cursor is on bullet character. 2946
2947Among other things, implements special behavior when the cursor is on the
2948topic bullet character.
2705 2949
2706When the cursor is on the bullet character, self-insert characters are 2950When the cursor is on the bullet character, self-insert characters are
2707reinterpreted as the corresponding control-character in the 2951reinterpreted as the corresponding control-character in the
@@ -2709,7 +2953,7 @@ reinterpreted as the corresponding control-character in the
2709the cursor which has moved as a result of such reinterpretation is 2953the cursor which has moved as a result of such reinterpretation is
2710positioned on the bullet character of the destination topic. 2954positioned on the bullet character of the destination topic.
2711 2955
2712The upshot is that you can get easy, single (ie, unmodified) key 2956The upshot is that you can get easy, single \(ie, unmodified\) key
2713outline maneuvering operations by positioning the cursor on the bullet 2957outline maneuvering operations by positioning the cursor on the bullet
2714char. When in this mode you can use regular cursor-positioning 2958char. When in this mode you can use regular cursor-positioning
2715command/keystrokes to relocate the cursor off of a bullet character to 2959command/keystrokes to relocate the cursor off of a bullet character to
@@ -2717,6 +2961,9 @@ return to regular interpretation of self-insert characters."
2717 2961
2718 (if (not (allout-mode-p)) 2962 (if (not (allout-mode-p))
2719 nil 2963 nil
2964 ;; Increment allout-command-counter
2965 (setq allout-command-counter (1+ allout-command-counter))
2966 ;; Do hot-spot navigation.
2720 (if (and (eq this-command 'self-insert-command) 2967 (if (and (eq this-command 'self-insert-command)
2721 (eq (point)(allout-current-bullet-pos))) 2968 (eq (point)(allout-current-bullet-pos)))
2722 (allout-hotspot-key-handler)))) 2969 (allout-hotspot-key-handler))))
@@ -2990,6 +3237,8 @@ case.)
2990 3237
2991If OFFER-RECENT-BULLET is true, offer to use the bullet of the prior sibling. 3238If OFFER-RECENT-BULLET is true, offer to use the bullet of the prior sibling.
2992 3239
3240Runs
3241
2993Nuances: 3242Nuances:
2994 3243
2995- Creation of new topics is with respect to the visible topic 3244- Creation of new topics is with respect to the visible topic
@@ -3040,7 +3289,8 @@ Nuances:
3040 allout-numbered-bullet)))) 3289 allout-numbered-bullet))))
3041 (point))) 3290 (point)))
3042 dbl-space 3291 dbl-space
3043 doing-beginning) 3292 doing-beginning
3293 start end)
3044 3294
3045 (if (not opening-on-blank) 3295 (if (not opening-on-blank)
3046 ; Positioning and vertical 3296 ; Positioning and vertical
@@ -3141,8 +3391,10 @@ Nuances:
3141 (not (bolp))) 3391 (not (bolp)))
3142 (forward-char 1)))) 3392 (forward-char 1))))
3143 )) 3393 ))
3394 (setq start (point))
3144 (insert (concat (allout-make-topic-prefix opening-numbered t depth) 3395 (insert (concat (allout-make-topic-prefix opening-numbered t depth)
3145 " ")) 3396 " "))
3397 (setq end (1+ (point)))
3146 3398
3147 (allout-rebullet-heading (and offer-recent-bullet ref-bullet) 3399 (allout-rebullet-heading (and offer-recent-bullet ref-bullet)
3148 depth nil nil t) 3400 depth nil nil t)
@@ -3150,6 +3402,8 @@ Nuances:
3150 (save-excursion (goto-char ref-topic) 3402 (save-excursion (goto-char ref-topic)
3151 (allout-show-children))) 3403 (allout-show-children)))
3152 (end-of-line) 3404 (end-of-line)
3405
3406 (run-hook-with-args 'allout-structure-added-hook start end)
3153 ) 3407 )
3154 ) 3408 )
3155;;;_ > allout-open-subtopic (arg) 3409;;;_ > allout-open-subtopic (arg)
@@ -3548,6 +3802,7 @@ discontinuity. The first topic in the file can be adjusted to any positive
3548depth, however." 3802depth, however."
3549 (interactive "p") 3803 (interactive "p")
3550 (if (> arg 0) 3804 (if (> arg 0)
3805 ;; refuse to create a containment discontinuity:
3551 (save-excursion 3806 (save-excursion
3552 (allout-back-to-current-heading) 3807 (allout-back-to-current-heading)
3553 (if (not (bobp)) 3808 (if (not (bobp))
@@ -3564,7 +3819,20 @@ depth, however."
3564 (1+ predecessor-depth))) 3819 (1+ predecessor-depth)))
3565 (error (concat "Disallowed shift deeper than" 3820 (error (concat "Disallowed shift deeper than"
3566 " containing topic's children."))))))) 3821 " containing topic's children.")))))))
3567 (allout-rebullet-topic arg)) 3822 (let ((where (point))
3823 has-successor)
3824 (if (and (< arg 0)
3825 (allout-current-topic-collapsed-p)
3826 (save-excursion (allout-next-sibling)))
3827 (setq has-successor t))
3828 (allout-rebullet-topic arg)
3829 (when (< arg 0)
3830 (save-excursion
3831 (if (allout-ascend)
3832 (allout-show-children)))
3833 (if has-successor
3834 (allout-show-children)))
3835 (run-hook-with-args 'allout-structure-shifted-hook arg where)))
3568;;;_ > allout-shift-out (arg) 3836;;;_ > allout-shift-out (arg)
3569(defun allout-shift-out (arg) 3837(defun allout-shift-out (arg)
3570 "Decrease depth of current heading and any topics collapsed within it. 3838 "Decrease depth of current heading and any topics collapsed within it.
@@ -3574,9 +3842,7 @@ one level greater than the immediately previous topic, to avoid containment
3574discontinuity. The first topic in the file can be adjusted to any positive 3842discontinuity. The first topic in the file can be adjusted to any positive
3575depth, however." 3843depth, however."
3576 (interactive "p") 3844 (interactive "p")
3577 (if (< arg 0) 3845 (allout-shift-in (* arg -1)))
3578 (allout-shift-in (* arg -1)))
3579 (allout-rebullet-topic (* arg -1)))
3580;;;_ : Surgery (kill-ring) functions with special provisions for outlines: 3846;;;_ : Surgery (kill-ring) functions with special provisions for outlines:
3581;;;_ > allout-kill-line (&optional arg) 3847;;;_ > allout-kill-line (&optional arg)
3582(defun allout-kill-line (&optional arg) 3848(defun allout-kill-line (&optional arg)
@@ -3610,7 +3876,8 @@ depth, however."
3610 (save-excursion ; Renumber subsequent topics if needed: 3876 (save-excursion ; Renumber subsequent topics if needed:
3611 (if (not (looking-at allout-regexp)) 3877 (if (not (looking-at allout-regexp))
3612 (allout-next-heading)) 3878 (allout-next-heading))
3613 (allout-renumber-to-depth depth)))))) 3879 (allout-renumber-to-depth depth)))
3880 (run-hook-with-args 'allout-structure-deleted-hook depth (point)))))
3614;;;_ > allout-kill-topic () 3881;;;_ > allout-kill-topic ()
3615(defun allout-kill-topic () 3882(defun allout-kill-topic ()
3616 "Kill topic together with subtopics. 3883 "Kill topic together with subtopics.
@@ -3656,7 +3923,8 @@ when yank with allout-yank into an outline as a heading."
3656 (allout-unprotected (kill-region beg (point))) 3923 (allout-unprotected (kill-region beg (point)))
3657 (sit-for 0) 3924 (sit-for 0)
3658 (save-excursion 3925 (save-excursion
3659 (allout-renumber-to-depth depth)))) 3926 (allout-renumber-to-depth depth))
3927 (run-hook-with-args 'allout-structure-deleted-hook depth (point))))
3660;;;_ > allout-yank-processing () 3928;;;_ > allout-yank-processing ()
3661(defun allout-yank-processing (&optional arg) 3929(defun allout-yank-processing (&optional arg)
3662 3930
@@ -3683,112 +3951,113 @@ however, are left exactly like normal, non-allout-specific yanks."
3683 ; region around subject: 3951 ; region around subject:
3684 (if (< (allout-mark-marker t) (point)) 3952 (if (< (allout-mark-marker t) (point))
3685 (exchange-point-and-mark)) 3953 (exchange-point-and-mark))
3686 (let* ((inhibit-field-text-motion t) 3954 (allout-unprotected
3687 (subj-beg (point)) 3955 (let* ((subj-beg (point))
3688 (into-bol (bolp)) 3956 (into-bol (bolp))
3689 (subj-end (allout-mark-marker t)) 3957 (subj-end (allout-mark-marker t))
3690 (was-collapsed (get-text-property subj-beg 'allout-was-collapsed)) 3958 (was-collapsed (get-text-property subj-beg 'allout-was-collapsed))
3691 ;; 'resituate' if yanking an entire topic into topic header: 3959 ;; 'resituate' if yanking an entire topic into topic header:
3692 (resituate (and (allout-e-o-prefix-p) 3960 (resituate (and (allout-e-o-prefix-p)
3693 (looking-at (concat "\\(" allout-regexp "\\)")) 3961 (looking-at (concat "\\(" allout-regexp "\\)"))
3694 (allout-prefix-data (match-beginning 1) 3962 (allout-prefix-data (match-beginning 1)
3695 (match-end 1)))) 3963 (match-end 1))))
3696 ;; `rectify-numbering' if resituating (where several topics may 3964 ;; `rectify-numbering' if resituating (where several topics may
3697 ;; be resituating) or yanking a topic into a topic slot (bol): 3965 ;; be resituating) or yanking a topic into a topic slot (bol):
3698 (rectify-numbering (or resituate 3966 (rectify-numbering (or resituate
3699 (and into-bol (looking-at allout-regexp))))) 3967 (and into-bol (looking-at allout-regexp)))))
3700 (if resituate 3968 (if resituate
3701 ; The yanked stuff is a topic: 3969 ; The yanked stuff is a topic:
3702 (let* ((prefix-len (- (match-end 1) subj-beg)) 3970 (let* ((prefix-len (- (match-end 1) subj-beg))
3703 (subj-depth (allout-recent-depth)) 3971 (subj-depth (allout-recent-depth))
3704 (prefix-bullet (allout-recent-bullet)) 3972 (prefix-bullet (allout-recent-bullet))
3705 (adjust-to-depth 3973 (adjust-to-depth
3706 ;; Nil if adjustment unnecessary, otherwise depth to which 3974 ;; Nil if adjustment unnecessary, otherwise depth to which
3707 ;; adjustment should be made: 3975 ;; adjustment should be made:
3708 (save-excursion 3976 (save-excursion
3709 (and (goto-char subj-end) 3977 (and (goto-char subj-end)
3710 (eolp) 3978 (eolp)
3711 (goto-char subj-beg) 3979 (goto-char subj-beg)
3712 (and (looking-at allout-regexp) 3980 (and (looking-at allout-regexp)
3713 (progn 3981 (progn
3714 (beginning-of-line) 3982 (beginning-of-line)
3715 (not (= (point) subj-beg))) 3983 (not (= (point) subj-beg)))
3716 (looking-at allout-regexp) 3984 (looking-at allout-regexp)
3717 (allout-prefix-data (match-beginning 0) 3985 (allout-prefix-data (match-beginning 0)
3718 (match-end 0))) 3986 (match-end 0)))
3719 (allout-recent-depth)))) 3987 (allout-recent-depth))))
3720 (more t)) 3988 (more t))
3721 (setq rectify-numbering allout-numbered-bullet) 3989 (setq rectify-numbering allout-numbered-bullet)
3722 (if adjust-to-depth 3990 (if adjust-to-depth
3723 ; Do the adjustment: 3991 ; Do the adjustment:
3724 (progn 3992 (progn
3725 (message "... yanking") (sit-for 0) 3993 (message "... yanking") (sit-for 0)
3726 (save-restriction 3994 (save-restriction
3727 (narrow-to-region subj-beg subj-end) 3995 (narrow-to-region subj-beg subj-end)
3728 ; Trim off excessive blank 3996 ; Trim off excessive blank
3729 ; line at end, if any: 3997 ; line at end, if any:
3730 (goto-char (point-max)) 3998 (goto-char (point-max))
3731 (if (looking-at "^$") 3999 (if (looking-at "^$")
3732 (allout-unprotected (delete-char -1))) 4000 (allout-unprotected (delete-char -1)))
3733 ; Work backwards, with each 4001 ; Work backwards, with each
3734 ; shallowest level, 4002 ; shallowest level,
3735 ; successively excluding the 4003 ; successively excluding the
3736 ; last processed topic from 4004 ; last processed topic from
3737 ; the narrow region: 4005 ; the narrow region:
3738 (while more 4006 (while more
3739 (allout-back-to-current-heading) 4007 (allout-back-to-current-heading)
3740 ; go as high as we can in each bunch: 4008 ; go as high as we can in each bunch:
3741 (while (allout-ascend-to-depth (1- (allout-depth)))) 4009 (while (allout-ascend-to-depth (1- (allout-depth))))
3742 (save-excursion 4010 (save-excursion
3743 (allout-rebullet-topic-grunt (- adjust-to-depth 4011 (allout-rebullet-topic-grunt (- adjust-to-depth
3744 subj-depth)) 4012 subj-depth))
3745 (allout-depth)) 4013 (allout-depth))
3746 (if (setq more (not (bobp))) 4014 (if (setq more (not (bobp)))
3747 (progn (widen) 4015 (progn (widen)
3748 (forward-char -1) 4016 (forward-char -1)
3749 (narrow-to-region subj-beg (point)))))) 4017 (narrow-to-region subj-beg (point))))))
3750 (message "") 4018 (message "")
3751 ;; Preserve new bullet if it's a distinctive one, otherwise 4019 ;; Preserve new bullet if it's a distinctive one, otherwise
3752 ;; use old one: 4020 ;; use old one:
3753 (if (string-match (regexp-quote prefix-bullet) 4021 (if (string-match (regexp-quote prefix-bullet)
3754 allout-distinctive-bullets-string) 4022 allout-distinctive-bullets-string)
3755 ; Delete from bullet of old to 4023 ; Delete from bullet of old to
3756 ; before bullet of new: 4024 ; before bullet of new:
3757 (progn 4025 (progn
3758 (beginning-of-line) 4026 (beginning-of-line)
3759 (delete-region (point) subj-beg) 4027 (delete-region (point) subj-beg)
3760 (set-marker (allout-mark-marker t) subj-end) 4028 (set-marker (allout-mark-marker t) subj-end)
3761 (goto-char subj-beg) 4029 (goto-char subj-beg)
3762 (allout-end-of-prefix)) 4030 (allout-end-of-prefix))
3763 ; Delete base subj prefix, 4031 ; Delete base subj prefix,
3764 ; leaving old one: 4032 ; leaving old one:
3765 (delete-region (point) (+ (point) 4033 (delete-region (point) (+ (point)
3766 prefix-len 4034 prefix-len
3767 (- adjust-to-depth subj-depth))) 4035 (- adjust-to-depth subj-depth)))
3768 ; and delete residual subj 4036 ; and delete residual subj
3769 ; prefix digits and space: 4037 ; prefix digits and space:
3770 (while (looking-at "[0-9]") (delete-char 1)) 4038 (while (looking-at "[0-9]") (delete-char 1))
3771 (if (looking-at " ") (delete-char 1)))) 4039 (if (looking-at " ") (delete-char 1))))
3772 (exchange-point-and-mark)))) 4040 (exchange-point-and-mark))))
3773 (if rectify-numbering 4041 (if rectify-numbering
3774 (progn 4042 (progn
3775 (save-excursion 4043 (save-excursion
3776 ; Give some preliminary feedback: 4044 ; Give some preliminary feedback:
3777 (message "... reconciling numbers") (sit-for 0) 4045 (message "... reconciling numbers") (sit-for 0)
3778 ; ... and renumber, in case necessary: 4046 ; ... and renumber, in case necessary:
3779 (goto-char subj-beg) 4047 (goto-char subj-beg)
3780 (if (allout-goto-prefix) 4048 (if (allout-goto-prefix)
3781 (allout-rebullet-heading nil ;;; solicit 4049 (allout-rebullet-heading nil ;;; solicit
3782 (allout-depth) ;;; depth 4050 (allout-depth) ;;; depth
3783 nil ;;; number-control 4051 nil ;;; number-control
3784 nil ;;; index 4052 nil ;;; index
3785 t)) 4053 t))
3786 (message "")))) 4054 (message ""))))
3787 (when (and (or into-bol resituate) was-collapsed) 4055 (when (and (or into-bol resituate) was-collapsed)
3788 (remove-text-properties subj-beg (1+ subj-beg) '(allout-was-collapsed)) 4056 (remove-text-properties subj-beg (1+ subj-beg) '(allout-was-collapsed))
3789 (allout-hide-current-subtree)) 4057 (allout-hide-current-subtree))
3790 (if (not resituate) 4058 (if (not resituate)
3791 (exchange-point-and-mark)))) 4059 (exchange-point-and-mark))
4060 (run-hook-with-args 'allout-structure-added-hook subj-beg subj-end))))
3792;;;_ > allout-yank (&optional arg) 4061;;;_ > allout-yank (&optional arg)
3793(defun allout-yank (&optional arg) 4062(defun allout-yank (&optional arg)
3794 "`allout-mode' yank, with depth and numbering adjustment of yanked topics. 4063 "`allout-mode' yank, with depth and numbering adjustment of yanked topics.
@@ -3820,10 +4089,10 @@ works with normal `yank' in non-outline buffers."
3820 4089
3821 (interactive "*P") 4090 (interactive "*P")
3822 (setq this-command 'yank) 4091 (setq this-command 'yank)
3823 (yank arg) 4092 (allout-unprotected
4093 (yank arg))
3824 (if (allout-mode-p) 4094 (if (allout-mode-p)
3825 (allout-yank-processing)) 4095 (allout-yank-processing)))
3826)
3827;;;_ > allout-yank-pop (&optional arg) 4096;;;_ > allout-yank-pop (&optional arg)
3828(defun allout-yank-pop (&optional arg) 4097(defun allout-yank-pop (&optional arg)
3829 "Yank-pop like `allout-yank' when popping to bare outline prefixes. 4098 "Yank-pop like `allout-yank' when popping to bare outline prefixes.
@@ -3882,9 +4151,13 @@ by pops to non-distinctive yanks. Bug..."
3882;;;_ - Fundamental 4151;;;_ - Fundamental
3883;;;_ > allout-flag-region (from to flag) 4152;;;_ > allout-flag-region (from to flag)
3884(defun allout-flag-region (from to flag) 4153(defun allout-flag-region (from to flag)
3885 "Conceal text from FROM to TO if FLAG is non-nil, else reveal it. 4154 "Conceal text between FROM and TO if FLAG is non-nil, else reveal it.
4155
4156Exposure-change hook `allout-exposure-change-hook' is run with the same
4157arguments as this function, after the exposure changes are made. \(The old
4158`allout-view-change-hook' is being deprecated, and eventually will not be
4159invoked.\)"
3886 4160
3887Text is shown if flag is nil and hidden otherwise."
3888 ;; We use outline invisibility spec. 4161 ;; We use outline invisibility spec.
3889 (remove-overlays from to 'category 'allout-exposure-category) 4162 (remove-overlays from to 'category 'allout-exposure-category)
3890 (when flag 4163 (when flag
@@ -3895,7 +4168,7 @@ Text is shown if flag is nil and hidden otherwise."
3895 (while props 4168 (while props
3896 (overlay-put o (pop props) (pop props))))))) 4169 (overlay-put o (pop props) (pop props)))))))
3897 (run-hooks 'allout-view-change-hook) 4170 (run-hooks 'allout-view-change-hook)
3898 (run-hooks 'allout-exposure-change-hook)) 4171 (run-hook-with-args 'allout-exposure-change-hook from to flag))
3899;;;_ > allout-flag-current-subtree (flag) 4172;;;_ > allout-flag-current-subtree (flag)
3900(defun allout-flag-current-subtree (flag) 4173(defun allout-flag-current-subtree (flag)
3901 "Conceal currently-visible topic's subtree if FLAG non-nil, else reveal it." 4174 "Conceal currently-visible topic's subtree if FLAG non-nil, else reveal it."
@@ -4071,10 +4344,12 @@ true, then single-line topics are considered to be collapsed. By
4071default, they are treated as being uncollapsed." 4344default, they are treated as being uncollapsed."
4072 (save-excursion 4345 (save-excursion
4073 (and 4346 (and
4074 (= (progn (allout-back-to-current-heading) 4347 ;; Is the topic all on one line (allowing for trailing blank line)?
4075 (move-end-of-line 1) 4348 (>= (progn (allout-back-to-current-heading)
4076 (point)) 4349 (move-end-of-line 1)
4077 (allout-end-of-current-subtree (not (looking-at "\n\n")))) 4350 (point))
4351 (allout-end-of-current-subtree (not (looking-at "\n\n"))))
4352
4078 (or include-single-liners 4353 (or include-single-liners
4079 (progn (backward-char 1) (allout-hidden-p)))))) 4354 (progn (backward-char 1) (allout-hidden-p))))))
4080;;;_ > allout-hide-current-subtree (&optional just-close) 4355;;;_ > allout-hide-current-subtree (&optional just-close)
@@ -5097,8 +5372,8 @@ See `allout-toggle-current-subtree-encryption' for more details."
5097;;; fetch-pass &optional retried verifying 5372;;; fetch-pass &optional retried verifying
5098;;; passphrase) 5373;;; passphrase)
5099(defun allout-encrypt-string (text decrypt allout-buffer key-type for-key 5374(defun allout-encrypt-string (text decrypt allout-buffer key-type for-key
5100 fetch-pass &optional retried verifying 5375 fetch-pass &optional retried rejected
5101 passphrase) 5376 verifying passphrase)
5102 "Encrypt or decrypt message TEXT. 5377 "Encrypt or decrypt message TEXT.
5103 5378
5104If DECRYPT is true (default false), then decrypt instead of encrypt. 5379If DECRYPT is true (default false), then decrypt instead of encrypt.
@@ -5116,6 +5391,11 @@ that have been solicited in sequence leading to this current call.
5116Optional PASSPHRASE enables explicit delivery of the decryption passphrase, 5391Optional PASSPHRASE enables explicit delivery of the decryption passphrase,
5117for verification purposes. 5392for verification purposes.
5118 5393
5394Optional REJECTED is for internal use - conveys the number of
5395rejections due to matches against
5396`allout-encryption-ciphertext-rejection-regexps', as limited by
5397`allout-encryption-ciphertext-rejection-ceiling'.
5398
5119Returns the resulting string, or nil if the transformation fails." 5399Returns the resulting string, or nil if the transformation fails."
5120 5400
5121 (require 'pgg) 5401 (require 'pgg)
@@ -5141,6 +5421,17 @@ Returns the resulting string, or nil if the transformation fails."
5141 target-prompt-id 5421 target-prompt-id
5142 (or (buffer-file-name allout-buffer) 5422 (or (buffer-file-name allout-buffer)
5143 target-prompt-id)))) 5423 target-prompt-id))))
5424 (strip-plaintext-regexps
5425 (if (not decrypt)
5426 (allout-get-configvar-values
5427 'allout-encryption-plaintext-sanitization-regexps)))
5428 (reject-ciphertext-regexps
5429 (if (not decrypt)
5430 (allout-get-configvar-values
5431 'allout-encryption-ciphertext-rejection-regexps)))
5432 (rejected (or rejected 0))
5433 (rejections-left (- allout-encryption-ciphertext-rejection-ceiling
5434 rejected))
5144 result-text status) 5435 result-text status)
5145 5436
5146 (if (and fetch-pass (not passphrase)) 5437 (if (and fetch-pass (not passphrase))
@@ -5161,10 +5452,19 @@ Returns the resulting string, or nil if the transformation fails."
5161 key-type 5452 key-type
5162 allout-buffer 5453 allout-buffer
5163 retried fetch-pass))) 5454 retried fetch-pass)))
5455
5164 (with-temp-buffer 5456 (with-temp-buffer
5165 5457
5166 (insert text) 5458 (insert text)
5167 5459
5460 (when (and strip-plaintext-regexps (not decrypt))
5461 (dolist (re strip-plaintext-regexps)
5462 (let ((re (if (listp re) (car re) re))
5463 (replacement (if (listp re) (cadr re) "")))
5464 (goto-char (point-min))
5465 (while (re-search-forward re nil t)
5466 (replace-match replacement nil nil)))))
5467
5168 (cond 5468 (cond
5169 5469
5170 ;; symmetric: 5470 ;; symmetric:
@@ -5183,7 +5483,8 @@ Returns the resulting string, or nil if the transformation fails."
5183 (if verifying 5483 (if verifying
5184 (throw 'encryption-failed nil) 5484 (throw 'encryption-failed nil)
5185 (pgg-remove-passphrase-from-cache target-cache-id t) 5485 (pgg-remove-passphrase-from-cache target-cache-id t)
5186 (error "Symmetric-cipher encryption failed - %s" 5486 (error "Symmetric-cipher %scryption failed - %s"
5487 (if decrypt "de" "en")
5187 "try again with different passphrase.")))) 5488 "try again with different passphrase."))))
5188 5489
5189 ;; encrypt 'keypair: 5490 ;; encrypt 'keypair:
@@ -5208,48 +5509,68 @@ Returns the resulting string, or nil if the transformation fails."
5208 (if status 5509 (if status
5209 (pgg-situate-output (point-min) (point-max)) 5510 (pgg-situate-output (point-min) (point-max))
5210 (error (pgg-remove-passphrase-from-cache target-cache-id t) 5511 (error (pgg-remove-passphrase-from-cache target-cache-id t)
5211 (error "decryption failed")))) 5512 (error "decryption failed")))))
5212 )
5213 5513
5214 (setq result-text 5514 (setq result-text
5215 (buffer-substring 1 (- (point-max) (if decrypt 0 1)))) 5515 (buffer-substring 1 (- (point-max) (if decrypt 0 1))))
5216
5217 ;; validate result - non-empty
5218 (cond ((not result-text)
5219 (if verifying
5220 nil
5221 ;; transform was fruitless, retry w/new passphrase.
5222 (pgg-remove-passphrase-from-cache target-cache-id t)
5223 (allout-encrypt-string text allout-buffer decrypt nil
5224 (if retried (1+ retried) 1)
5225 passphrase)))
5226
5227 ;; Barf if encryption yields extraordinary control chars:
5228 ((and (not decrypt)
5229 (string-match "[\C-a\C-k\C-o-\C-z\C-@]"
5230 result-text))
5231 (error (concat "encryption produced unusable"
5232 " non-armored text - reconfigure!")))
5233
5234 ;; valid result and just verifying or non-symmetric:
5235 ((or verifying (not (equal key-type 'symmetric)))
5236 (if (or verifying decrypt)
5237 (pgg-add-passphrase-to-cache target-cache-id
5238 passphrase t))
5239 result-text)
5240
5241 ;; valid result and regular symmetric - "register"
5242 ;; passphrase with mnemonic aids/cache.
5243 (t
5244 (set-buffer allout-buffer)
5245 (if passphrase
5246 (pgg-add-passphrase-to-cache target-cache-id
5247 passphrase t))
5248 (allout-update-passphrase-mnemonic-aids for-key passphrase
5249 allout-buffer)
5250 result-text)
5251 )
5252 ) 5516 )
5517
5518 ;; validate result - non-empty
5519 (cond ((not result-text)
5520 (if verifying
5521 nil
5522 ;; transform was fruitless, retry w/new passphrase.
5523 (pgg-remove-passphrase-from-cache target-cache-id t)
5524 (allout-encrypt-string text decrypt allout-buffer
5525 key-type for-key nil
5526 (if retried (1+ retried) 1)
5527 rejected verifying nil)))
5528
5529 ;; Retry (within limit) if ciphertext contains rejections:
5530 ((and (not decrypt)
5531 ;; Check for disqualification of this ciphertext:
5532 (let ((regexps reject-ciphertext-regexps)
5533 reject-it)
5534 (while (and regexps (not reject-it))
5535 (setq reject-it (string-match (car regexps)
5536 result-text))
5537 (pop regexps))
5538 reject-it))
5539 (setq rejections-left (1- rejections-left))
5540 (if (<= rejections-left 0)
5541 (error (concat "Ciphertext rejected too many times"
5542 " (%s), per `%s'")
5543 allout-encryption-ciphertext-rejection-ceiling
5544 'allout-encryption-ciphertext-rejection-regexps)
5545 (allout-encrypt-string text decrypt allout-buffer
5546 key-type for-key nil
5547 retried (1+ rejected)
5548 verifying passphrase)))
5549 ;; Barf if encryption yields extraordinary control chars:
5550 ((and (not decrypt)
5551 (string-match "[\C-a\C-k\C-o-\C-z\C-@]"
5552 result-text))
5553 (error (concat "Encryption produced non-armored text, which"
5554 "conflicts with allout mode - reconfigure!")))
5555
5556 ;; valid result and just verifying or non-symmetric:
5557 ((or verifying (not (equal key-type 'symmetric)))
5558 (if (or verifying decrypt)
5559 (pgg-add-passphrase-to-cache target-cache-id
5560 passphrase t))
5561 result-text)
5562
5563 ;; valid result and regular symmetric - "register"
5564 ;; passphrase with mnemonic aids/cache.
5565 (t
5566 (set-buffer allout-buffer)
5567 (if passphrase
5568 (pgg-add-passphrase-to-cache target-cache-id
5569 passphrase t))
5570 (allout-update-passphrase-mnemonic-aids for-key passphrase
5571 allout-buffer)
5572 result-text)
5573 )
5253 ) 5574 )
5254 ) 5575 )
5255 ) 5576 )
@@ -5313,7 +5634,6 @@ of the availability of a cached copy."
5313 (pgg-read-passphrase-from-cache cache-id t))) 5634 (pgg-read-passphrase-from-cache cache-id t)))
5314 (got-pass (or cached 5635 (got-pass (or cached
5315 (pgg-read-passphrase full-prompt cache-id t))) 5636 (pgg-read-passphrase full-prompt cache-id t)))
5316
5317 confirmation) 5637 confirmation)
5318 5638
5319 (if (not got-pass) 5639 (if (not got-pass)
@@ -5321,14 +5641,14 @@ of the availability of a cached copy."
5321 5641
5322 ;; Duplicate our handle on the passphrase so it's not clobbered by 5642 ;; Duplicate our handle on the passphrase so it's not clobbered by
5323 ;; deactivate-passwd memory clearing: 5643 ;; deactivate-passwd memory clearing:
5324 (setq got-pass (format "%s" got-pass)) 5644 (setq got-pass (copy-sequence got-pass))
5325 5645
5326 (cond (verifier-string 5646 (cond (verifier-string
5327 (save-window-excursion 5647 (save-window-excursion
5328 (if (allout-encrypt-string verifier-string 'decrypt 5648 (if (allout-encrypt-string verifier-string 'decrypt
5329 allout-buffer 'symmetric 5649 allout-buffer 'symmetric
5330 for-key nil 0 'verifying 5650 for-key nil 0 0 'verifying
5331 got-pass) 5651 (copy-sequence got-pass))
5332 (setq confirmation (format "%s" got-pass)))) 5652 (setq confirmation (format "%s" got-pass))))
5333 5653
5334 (if (and (not confirmation) 5654 (if (and (not confirmation)
@@ -5365,15 +5685,7 @@ of the availability of a cached copy."
5365 ;; recurse to this routine: 5685 ;; recurse to this routine:
5366 (pgg-read-passphrase prompt-sans-hint cache-id t)) 5686 (pgg-read-passphrase prompt-sans-hint cache-id t))
5367 (pgg-remove-passphrase-from-cache cache-id t) 5687 (pgg-remove-passphrase-from-cache cache-id t)
5368 (error "Confirmation failed."))) 5688 (error "Confirmation failed."))))))))
5369 ;; reduce opportunity for memory cherry-picking by zeroing duplicate:
5370 (dotimes (i (length got-pass))
5371 (aset got-pass i 0))
5372 )
5373 )
5374 )
5375 )
5376 )
5377;;;_ > allout-encrypted-topic-p () 5689;;;_ > allout-encrypted-topic-p ()
5378(defun allout-encrypted-topic-p () 5690(defun allout-encrypted-topic-p ()
5379 "True if the current topic is encryptable and encrypted." 5691 "True if the current topic is encryptable and encrypted."
@@ -5426,7 +5738,7 @@ An error is raised if the text is not encrypted."
5426 (dotimes (i (length spew)) 5738 (dotimes (i (length spew))
5427 (aset spew i (1+ (random 254)))) 5739 (aset spew i (1+ (random 254))))
5428 (allout-encrypt-string spew nil (current-buffer) 'symmetric 5740 (allout-encrypt-string spew nil (current-buffer) 'symmetric
5429 nil nil 0 passphrase)) 5741 nil nil 0 0 passphrase))
5430 ) 5742 )
5431;;;_ > allout-update-passphrase-mnemonic-aids (for-key passphrase 5743;;;_ > allout-update-passphrase-mnemonic-aids (for-key passphrase
5432;;; outline-buffer) 5744;;; outline-buffer)
@@ -5505,7 +5817,7 @@ Derived from value of `allout-passphrase-verifier-string'."
5505 allout-passphrase-verifier-string 5817 allout-passphrase-verifier-string
5506 (allout-encrypt-string (allout-get-encryption-passphrase-verifier) 5818 (allout-encrypt-string (allout-get-encryption-passphrase-verifier)
5507 'decrypt allout-buffer 'symmetric 5819 'decrypt allout-buffer 'symmetric
5508 key nil 0 'verifying passphrase) 5820 key nil 0 0 'verifying passphrase)
5509 t))) 5821 t)))
5510;;;_ > allout-next-topic-pending-encryption (&optional except-mark) 5822;;;_ > allout-next-topic-pending-encryption (&optional except-mark)
5511(defun allout-next-topic-pending-encryption (&optional except-mark) 5823(defun allout-next-topic-pending-encryption (&optional except-mark)
@@ -5808,6 +6120,25 @@ If BEG is bigger than END we return 0."
5808 (goto-char (1+ (match-beginning 0))) 6120 (goto-char (1+ (match-beginning 0)))
5809 (setq count (1+ count))) 6121 (setq count (1+ count)))
5810 count)))) 6122 count))))
6123;;;_ > allout-get-configvar-values (varname)
6124(defun allout-get-configvar-values (configvar-name)
6125 "Return a list of values of the symbols in list bound to CONFIGVAR-NAME.
6126
6127The user is prompted for removal of symbols that are unbound, and they
6128otherwise are ignored.
6129
6130CONFIGVAR-NAME should be the name of the configuration variable,
6131not its value."
6132
6133 (let ((configvar-value (symbol-value configvar-name))
6134 got)
6135 (dolist (sym configvar-value)
6136 (if (not (boundp sym))
6137 (if (yes-or-no-p (format "%s entry `%s' is unbound - remove it? "
6138 configvar-name sym))
6139 (delq sym (symbol-value configvar-name)))
6140 (push (symbol-value sym) got)))
6141 (reverse got)))
5811;;;_ > allout-mark-marker to accommodate divergent emacsen: 6142;;;_ > allout-mark-marker to accommodate divergent emacsen:
5812(defun allout-mark-marker (&optional force buffer) 6143(defun allout-mark-marker (&optional force buffer)
5813 "Accommodate the different signature for `mark-marker' across Emacsen. 6144 "Accommodate the different signature for `mark-marker' across Emacsen.