diff options
Diffstat (limited to 'lisp/allout.el')
| -rw-r--r-- | lisp/allout.el | 813 |
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 | |||
| 220 | Cycling only happens on when the command is repeated, not when it | ||
| 221 | follows a different command. | ||
| 222 | |||
| 223 | Smart-placement means that repeated calls to this function will | ||
| 224 | advance 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 | |||
| 239 | In this fashion, you can use the beginning-of-line command to do | ||
| 240 | its normal job and then, when repeated, advance through the | ||
| 241 | entry, cycling back to start. | ||
| 242 | |||
| 243 | If this configuration variable is nil, then the cursor is just | ||
| 244 | advanced to the beginning of the line and remains there on | ||
| 245 | repeated 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 | |||
| 251 | Cycling only happens on when the command is repeated, not when it | ||
| 252 | follows a different command. | ||
| 253 | |||
| 254 | Smart-placement means that repeated calls to this function will | ||
| 255 | advance 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 | |||
| 264 | In this fashion, you can use the end-of-line command to do its | ||
| 265 | normal job and then, when repeated, advance through the entry, | ||
| 266 | cycling back to start. | ||
| 267 | |||
| 268 | If this configuration variable is nil, then the cursor is just | ||
| 269 | advanced to the end of the line and remains there on repeated | ||
| 270 | calls." | ||
| 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 | ||
| 220 | Outline topic header lines are identified by a leading topic | 279 | Outline topic header lines are identified by a leading topic |
| 221 | header prefix, which mostly have the value of this var at their front. | 280 | header prefix, which mostly have the value of this var at their front. |
| 222 | \(Level 1 topics are exceptions. They consist of only a single | 281 | Level 1 topics are exceptions. They consist of only a single |
| 223 | character, which is typically set to the `allout-primary-bullet'. Many | 282 | character, which is typically set to the `allout-primary-bullet'." |
| 224 | outlines 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 | ||
| 303 | Allout outline mode will use the mode-specific `allout-mode-leaders' | 361 | Allout outline mode will use the mode-specific `allout-mode-leaders' or |
| 304 | and/or comment-start string, if any, to lead the topic prefix string, | 362 | comment-start string, if any, to lead the topic prefix string, so topic |
| 305 | so topic headers look like comments in the programming language. | 363 | headers look like comments in the programming language. It will also use |
| 364 | the comment-start string, with an '_' appended, for `allout-primary-bullet'. | ||
| 306 | 365 | ||
| 307 | String values are used as they stand. | 366 | String values are used as literals, not regular expressions, so |
| 367 | do not escape any regulare-expression characters. | ||
| 308 | 368 | ||
| 309 | Value t means to first check for assoc value in `allout-mode-leaders' | 369 | Value t means to first check for assoc value in `allout-mode-leaders' |
| 310 | alist, then use comment-start string, if any, then use default \(`.'). | 370 | alist, 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 \(`.'). | |||
| 313 | Set to the symbol for either of `allout-mode-leaders' or | 373 | Set 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 | ||
| 316 | Value nil means to always use the default \(`.'). | 376 | Value nil means to always use the default \(`.') and leave |
| 317 | 377 | `allout-primary-bullet' unaltered. | |
| 318 | comment-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 | 379 | comment-start strings that do not end in spaces are tripled in |
| 320 | comment strings. comment-start strings that do end in spaces are not | 380 | the header-prefix, and an `_' underscore is tacked on the end, to |
| 321 | tripled, but an underscore is substituted for the space. [This | 381 | distinguish them from regular comment strings. comment-start |
| 322 | presumes that the space is for appearance, not comment syntax. You | 382 | strings that do end in spaces are not tripled, but an underscore |
| 323 | can use `allout-mode-leaders' to override this behavior, when | 383 | is substituted for the space. [This presumes that the space is |
| 324 | incorrect.]" | 384 | for appearance, not comment syntax. You can use |
| 385 | `allout-mode-leaders' to override this behavior, when | ||
| 386 | undesired.]" | ||
| 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 | ||
| 337 | Entries will be used instead or in lieu of mode-specific | 399 | Use this if the mode's comment-start string isn't what you |
| 338 | comment-start strings. See also `allout-use-mode-specific-leader'. | 400 | prefer, or if the mode lacks a comment-start string. See |
| 401 | `allout-use-mode-specific-leader' for more details. | ||
| 339 | 402 | ||
| 340 | If you're constructing a string that will comment-out outline | 403 | If you're constructing a string that will comment-out outline |
| 341 | structuring so it can be included in program code, append an extra | 404 | structuring so it can be included in program code, append an extra |
| 342 | character, like an \"_\" underscore, to distinguish the lead string | 405 | character, like an \"_\" underscore, to distinguish the lead string |
| 343 | from regular comments that start at bol.") | 406 | from 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 | ||
| 835 | Works according to settings of: | 898 | Works 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 | ||
| 971 | resurrecting, on mode deactivation, bindings that existed before | ||
| 972 | activation. 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 | ||
| 976 | resurrecting, on mode deactivation, bindings that existed before | ||
| 977 | activation. 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 | ||
| 1055 | Old settings are preserved for later resumption using `allout-do-resumptions'. | 1112 | Old settings are preserved for later resumption using `allout-do-resumptions'. |
| 1056 | 1113 | ||
| 1114 | The new values are set as a buffer local. On resumption, the prior buffer | ||
| 1115 | scope of the variable is restored along with its value. If it was a void | ||
| 1116 | buffer-local value, then it is left as nil on resumption. | ||
| 1117 | |||
| 1057 | The pairs are lists whose car is the name of the variable and car of the | 1118 | The pairs are lists whose car is the name of the variable and car of the |
| 1058 | cdr is the new value: '(some-var some-value)'. | 1119 | cdr is the new value: '(some-var some-value)'. The pairs can actually be |
| 1120 | triples, where the third element qualifies the disposition of the setting, | ||
| 1121 | as described further below. | ||
| 1059 | 1122 | ||
| 1060 | The new value is set as a buffer local. | 1123 | If the optional third element is the symbol 'extend, then the new value |
| 1124 | created by `cons'ing the second element of the pair onto the front of the | ||
| 1125 | existing value. | ||
| 1061 | 1126 | ||
| 1062 | If the variable was not previously buffer-local, then that is noted and the | 1127 | If 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. | 1128 | extended from the existing one by `append'ing a list containing the second |
| 1129 | element of the pair onto the end of the existing value. | ||
| 1064 | 1130 | ||
| 1065 | If it previously was buffer-local, the old value is noted and resurrected | 1131 | Extension, and resumptions in general, should not be used for hook |
| 1066 | by `allout-do-resumptions'. \(If the local value was previously void, then | 1132 | functions - use the 'local mode of `add-hook' for that, instead. |
| 1067 | it is left as nil on resumption.\) | ||
| 1068 | 1133 | ||
| 1069 | The settings are stored on `allout-mode-prior-settings'." | 1134 | The 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 | ||
| 1126 | Switch to using `allout-exposure-change-hook' instead. Both | 1205 | Switch to using `allout-exposure-change-hook' instead. Both hooks are |
| 1127 | variables are currently respected, but this one will be ignored | 1206 | currently respected, but the other conveys the details of the exposure |
| 1128 | in a subsequent allout version.") | 1207 | change via explicit parameters, and this one will eventually be disabled in |
| 1208 | a 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 | |||
| 1213 | It is run at the conclusion of `allout-flag-region'. | ||
| 1214 | |||
| 1215 | Functions 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 | |||
| 1221 | This hook might be invoked multiple times by a single command. | ||
| 1222 | |||
| 1223 | This hook is replacing `allout-view-change-hook', which is being deprecated | ||
| 1224 | and 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 | |||
| 1229 | Functions 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 | |||
| 1234 | Some edits that introduce new items may missed by this hook - | ||
| 1235 | specifically edits that native allout routines do not control. | ||
| 1236 | |||
| 1237 | This 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 | |||
| 1242 | Functions 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 | |||
| 1247 | Some edits that remove or invalidate items may missed by this hook - | ||
| 1248 | specifically edits that native allout routines do not control. | ||
| 1132 | 1249 | ||
| 1133 | This variable will replace `allout-view-change-hook' in a subsequent allout | 1250 | This hook might be invoked multiple times by a single command.") |
| 1134 | version, 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 | ||
| 1255 | Functions 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 | |||
| 1260 | Some edits that shift items can be missed by this hook - specifically edits | ||
| 1261 | that native allout routines do not control. | ||
| 1262 | |||
| 1263 | This 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 | |||
| 1186 | This is used to decrypt the topic that was currently being edited, if it | 1314 | This is used to decrypt the topic that was currently being edited, if it |
| 1187 | was encrypted automatically as part of a file write or autosave.") | 1315 | was 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 | |||
| 1321 | This is for the sake of removing artifacts, like escapes, that are added on | ||
| 1322 | and not actually part of the original plaintext. The removal is done just | ||
| 1323 | prior to encryption. | ||
| 1324 | |||
| 1325 | Entries must be symbols that are bound to the desired values. | ||
| 1326 | |||
| 1327 | Each value can be a regexp or a list with a regexp followed by a | ||
| 1328 | substitution string. If it's just a regexp, all its matches are removed | ||
| 1329 | before the text is encrypted. If it's a regexp and a substitution, the | ||
| 1330 | substition 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 | |||
| 1336 | This is for the sake of redoing encryption in cases where the ciphertext | ||
| 1337 | incidentally contains strings that would disrupt mode operation - | ||
| 1338 | for example, a line that happens to look like an allout-mode topic prefix. | ||
| 1339 | |||
| 1340 | Entries must be symbols that are bound to the desired regexp values. | ||
| 1341 | |||
| 1342 | The encryption will be retried up to | ||
| 1343 | `allout-encryption-ciphertext-rejection-limit' times, after which an error | ||
| 1344 | is 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 | |||
| 1351 | See `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 | ||
| 2115 | Optional argument LEVELS specifies the depth \(relative to start | 2337 | Optional argument LEVELS specifies the depth \(relative to start |
| 2116 | depth) for the chart. Subsequent optional args are not for public | 2338 | depth) for the chart. |
| 2117 | use. | 2339 | |
| 2340 | When optional argument VISIBLE is non-nil, the chart includes | ||
| 2341 | only the visible subelements of the charted subjects. | ||
| 2342 | |||
| 2343 | The remaining optional args are not for internal use by the function. | ||
| 2118 | 2344 | ||
| 2119 | Point is left at the end of the subtree. | 2345 | Point 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 | |||
| 2675 | are mapped to the command of the corresponding control-key on the | 2910 | are 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 | |||
| 2917 | Set by `allout-pre-command-business', to support allout addons in | ||
| 2918 | coordinating 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. |
| 2704 | Implements special behavior when cursor is on bullet character. | 2946 | |
| 2947 | Among other things, implements special behavior when the cursor is on the | ||
| 2948 | topic bullet character. | ||
| 2705 | 2949 | ||
| 2706 | When the cursor is on the bullet character, self-insert characters are | 2950 | When the cursor is on the bullet character, self-insert characters are |
| 2707 | reinterpreted as the corresponding control-character in the | 2951 | reinterpreted as the corresponding control-character in the |
| @@ -2709,7 +2953,7 @@ reinterpreted as the corresponding control-character in the | |||
| 2709 | the cursor which has moved as a result of such reinterpretation is | 2953 | the cursor which has moved as a result of such reinterpretation is |
| 2710 | positioned on the bullet character of the destination topic. | 2954 | positioned on the bullet character of the destination topic. |
| 2711 | 2955 | ||
| 2712 | The upshot is that you can get easy, single (ie, unmodified) key | 2956 | The upshot is that you can get easy, single \(ie, unmodified\) key |
| 2713 | outline maneuvering operations by positioning the cursor on the bullet | 2957 | outline maneuvering operations by positioning the cursor on the bullet |
| 2714 | char. When in this mode you can use regular cursor-positioning | 2958 | char. When in this mode you can use regular cursor-positioning |
| 2715 | command/keystrokes to relocate the cursor off of a bullet character to | 2959 | command/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 | ||
| 2991 | If OFFER-RECENT-BULLET is true, offer to use the bullet of the prior sibling. | 3238 | If OFFER-RECENT-BULLET is true, offer to use the bullet of the prior sibling. |
| 2992 | 3239 | ||
| 3240 | Runs | ||
| 3241 | |||
| 2993 | Nuances: | 3242 | Nuances: |
| 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 | |||
| 3548 | depth, however." | 3802 | depth, 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 | |||
| 3574 | discontinuity. The first topic in the file can be adjusted to any positive | 3842 | discontinuity. The first topic in the file can be adjusted to any positive |
| 3575 | depth, however." | 3843 | depth, 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 | |||
| 4156 | Exposure-change hook `allout-exposure-change-hook' is run with the same | ||
| 4157 | arguments as this function, after the exposure changes are made. \(The old | ||
| 4158 | `allout-view-change-hook' is being deprecated, and eventually will not be | ||
| 4159 | invoked.\)" | ||
| 3886 | 4160 | ||
| 3887 | Text 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 | |||
| 4071 | default, they are treated as being uncollapsed." | 4344 | default, 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 | ||
| 5104 | If DECRYPT is true (default false), then decrypt instead of encrypt. | 5379 | If 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. | |||
| 5116 | Optional PASSPHRASE enables explicit delivery of the decryption passphrase, | 5391 | Optional PASSPHRASE enables explicit delivery of the decryption passphrase, |
| 5117 | for verification purposes. | 5392 | for verification purposes. |
| 5118 | 5393 | ||
| 5394 | Optional REJECTED is for internal use - conveys the number of | ||
| 5395 | rejections due to matches against | ||
| 5396 | `allout-encryption-ciphertext-rejection-regexps', as limited by | ||
| 5397 | `allout-encryption-ciphertext-rejection-ceiling'. | ||
| 5398 | |||
| 5119 | Returns the resulting string, or nil if the transformation fails." | 5399 | Returns 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 | |||
| 6127 | The user is prompted for removal of symbols that are unbound, and they | ||
| 6128 | otherwise are ignored. | ||
| 6129 | |||
| 6130 | CONFIGVAR-NAME should be the name of the configuration variable, | ||
| 6131 | not 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. |