diff options
| author | Eli Zaretskii | 2006-07-14 11:26:36 +0000 |
|---|---|---|
| committer | Eli Zaretskii | 2006-07-14 11:26:36 +0000 |
| commit | 01fc9422ddb1e7f1f47c1f58117cdb078d118711 (patch) | |
| tree | f581c97cfdf665bf0a6c3325f1e8338583ea1ad6 | |
| parent | dcc881213c9b7d6b6df11f394ce62f3a747c9ec5 (diff) | |
| download | emacs-01fc9422ddb1e7f1f47c1f58117cdb078d118711.tar.gz emacs-01fc9422ddb1e7f1f47c1f58117cdb078d118711.zip | |
Require 'cl during byte-compilation/interactive load, for the `assert' macro.
(allout-mode-deactivate-hook): New hook, is run when allout mode deactivates.
(allout-developer): New allout customization subgroup.
(allout-run-unit-tests-on-load): New allout-developer
customization variable, when true allout unit tests are run towards end of file
load/eval.
(allout-inhibit-auto-fill): Disable auto-fill activity even during
auto-fill-mode.
(allout-resumptions): Removed, to be replaced by...
(allout-add-resumptions): Register variable settings to be reinstated by
`allout-do-resumptions'. The settings are made buffer-local, but the
locality/globality of the suspended setting is restored on resumption.
(allout-do-resumptions): Reinstate all settings suspended using
`allout-add-resumptions'.
(allout-test-resumptions): Unit tests (and intermediate variables) for
resumptions.
(allout-tests-globally-unbound, allout-tests-globally-true)
(allout-tests-locally-true): Intermediate variables for resumptions unit tests.
(allout-overlay-preparations): Replaces `allout-set-overlay-category'.
(allout-exposure-category): Replaces 'allout-overlay-category variable.
(allout-mode): Use `allout-add-resumptions' and `allout-do-resumptions'
instead of retired `allout-resumptions'. For hook functions, use `local'
parameter so hook settings are created and removed as
buffer-local settings. Revise (resumptions) setting auto-fill-function so it
is set only if already active. (The related fill-function settings are all
made in either case, so that activating auto-fill-mode activity will have the
custom allout-mode behaviors (hanging indent on topics, if configured for it).
Also, remove all allout-exposure-category overlays on mode deactivation.
(allout-hotspot-key-handler): New function extracted from
`allout-pre-command-business', so the functionality can be used for other
purposes, eg as a binding in an overlay.
(allout-pre-command-business): Use new `allout-hotspot-key-handler'.
(allout-auto-fill): Respect new `allout-inhibit-auto-fill' customization
variable.
(allout-run-unit-tests): Run the (currently quite small) repertoire of unit
tests. Called just before the provide iff user has customized
`allout-run-unit-tests-on-load' non-nil.
| -rw-r--r-- | lisp/ChangeLog | 46 | ||||
| -rw-r--r-- | lisp/allout.el | 645 |
2 files changed, 453 insertions, 238 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3bbe4862768..b095c35ee0a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,49 @@ | |||
| 1 | 2006-07-14 Ken Manheimer <ken.manheimer@gmail.com> | ||
| 2 | |||
| 3 | * allout.el: Require 'cl during byte-compilation/interactive load, | ||
| 4 | for the `assert' macro. | ||
| 5 | (allout-mode-deactivate-hook): New hook, is run when allout mode | ||
| 6 | deactivates. | ||
| 7 | (allout-developer): New allout customization subgroup. | ||
| 8 | (allout-run-unit-tests-on-load): New allout-developer | ||
| 9 | customization variable, when true allout unit tests are run towards | ||
| 10 | end of file load/eval. | ||
| 11 | (allout-inhibit-auto-fill): Disable auto-fill activity even during | ||
| 12 | auto-fill-mode. | ||
| 13 | (allout-resumptions): Removed, to be replaced by... | ||
| 14 | (allout-add-resumptions): Register variable settings to be | ||
| 15 | reinstated by `allout-do-resumptions'. The settings are made | ||
| 16 | buffer-local, but the locality/globality of the suspended setting | ||
| 17 | is restored on resumption. | ||
| 18 | (allout-do-resumptions): Reinstate all settings suspended using | ||
| 19 | `allout-add-resumptions'. | ||
| 20 | (allout-test-resumptions): Unit tests (and intermediate variables) | ||
| 21 | for resumptions. | ||
| 22 | (allout-tests-globally-unbound, allout-tests-globally-true) | ||
| 23 | (allout-tests-locally-true): Intermediate variables for | ||
| 24 | resumptions unit tests. | ||
| 25 | (allout-overlay-preparations): Replaces `allout-set-overlay-category'. | ||
| 26 | (allout-exposure-category): Replaces 'allout-overlay-category variable. | ||
| 27 | (allout-mode): Use `allout-add-resumptions' and `allout-do-resumptions' | ||
| 28 | instead of retired `allout-resumptions'. For hook functions, use | ||
| 29 | `local' parameter so hook settings are created and removed as | ||
| 30 | buffer-local settings. Revise (resumptions) setting | ||
| 31 | auto-fill-function so it is set only if already active. (The | ||
| 32 | related fill-function settings are all made in either case, so | ||
| 33 | that activating auto-fill-mode activity will have the custom | ||
| 34 | allout-mode behaviors (hanging indent on topics, if configured for | ||
| 35 | it). Also, remove all allout-exposure-category overlays on mode | ||
| 36 | deactivation. | ||
| 37 | (allout-hotspot-key-handler): New function extracted from | ||
| 38 | `allout-pre-command-business', so the functionality can be used | ||
| 39 | for other purposes, eg as a binding in an overlay. | ||
| 40 | (allout-pre-command-business): Use new `allout-hotspot-key-handler'. | ||
| 41 | (allout-auto-fill): Respect new `allout-inhibit-auto-fill' | ||
| 42 | customization variable. | ||
| 43 | (allout-run-unit-tests): Run the (currently quite small) | ||
| 44 | repertoire of unit tests. Called just before the provide iff user | ||
| 45 | has customized `allout-run-unit-tests-on-load' non-nil. | ||
| 46 | |||
| 1 | 2006-07-14 K,Aa(Broly L,Bu(Brentey <lorentey@elte.hu> | 47 | 2006-07-14 K,Aa(Broly L,Bu(Brentey <lorentey@elte.hu> |
| 2 | 48 | ||
| 3 | * emacs-lisp/authors.el (authors-aliases): Update. | 49 | * emacs-lisp/authors.el (authors-aliases): Update. |
diff --git a/lisp/allout.el b/lisp/allout.el index 2fbef5b2cd8..f7d143be82e 100644 --- a/lisp/allout.el +++ b/lisp/allout.el | |||
| @@ -8,6 +8,7 @@ | |||
| 8 | ;; Created: Dec 1991 - first release to usenet | 8 | ;; Created: Dec 1991 - first release to usenet |
| 9 | ;; Version: 2.2.1 | 9 | ;; Version: 2.2.1 |
| 10 | ;; Keywords: outlines wp languages | 10 | ;; Keywords: outlines wp languages |
| 11 | ;; Website: http://myriadicity.net/Sundry/EmacsAllout | ||
| 11 | 12 | ||
| 12 | ;; This file is part of GNU Emacs. | 13 | ;; This file is part of GNU Emacs. |
| 13 | 14 | ||
| @@ -58,7 +59,9 @@ | |||
| 58 | ;; and more. | 59 | ;; and more. |
| 59 | ;; | 60 | ;; |
| 60 | ;; See the `allout-mode' function's docstring for an introduction to the | 61 | ;; See the `allout-mode' function's docstring for an introduction to the |
| 61 | ;; mode. The development version and helpful notes are available at | 62 | ;; mode. |
| 63 | ;; | ||
| 64 | ;; The latest development version and helpful notes are available at | ||
| 62 | ;; http://myriadicity.net/Sundry/EmacsAllout . | 65 | ;; http://myriadicity.net/Sundry/EmacsAllout . |
| 63 | ;; | 66 | ;; |
| 64 | ;; The outline menubar additions provide quick reference to many of | 67 | ;; The outline menubar additions provide quick reference to many of |
| @@ -80,10 +83,19 @@ | |||
| 80 | 83 | ||
| 81 | ;;;_* Dependency autoloads | 84 | ;;;_* Dependency autoloads |
| 82 | (require 'overlay) | 85 | (require 'overlay) |
| 83 | (eval-when-compile (progn (require 'pgg) | 86 | (eval-when-compile |
| 84 | (require 'pgg-gpg) | 87 | ;; Most of the requires here are for stuff covered by autoloads. |
| 85 | (require 'overlay) | 88 | ;; Since just byte-compiling doesn't trigger autoloads, so that |
| 86 | )) | 89 | ;; "function not found" warnings would occur without these requires. |
| 90 | (progn | ||
| 91 | (require 'pgg) | ||
| 92 | (require 'pgg-gpg) | ||
| 93 | (require 'overlay) | ||
| 94 | ;; `cl' is required for `assert'. `assert' is not covered by a standard | ||
| 95 | ;; autoload, but it is a macro, so that eval-when-compile is sufficient | ||
| 96 | ;; to byte-compile it in, or to do the require when the buffer evalled. | ||
| 97 | (require 'cl) | ||
| 98 | )) | ||
| 87 | 99 | ||
| 88 | ;;;_* USER CUSTOMIZATION VARIABLES: | 100 | ;;;_* USER CUSTOMIZATION VARIABLES: |
| 89 | 101 | ||
| @@ -556,6 +568,25 @@ disable auto-saves for that file." | |||
| 556 | :group 'allout-encryption) | 568 | :group 'allout-encryption) |
| 557 | (make-variable-buffer-local 'allout-encrypt-unencrypted-on-saves) | 569 | (make-variable-buffer-local 'allout-encrypt-unencrypted-on-saves) |
| 558 | 570 | ||
| 571 | ;;;_ + Developer | ||
| 572 | ;;;_ = allout-developer group | ||
| 573 | (defgroup allout-developer nil | ||
| 574 | "Settings for topic encryption features of allout outliner." | ||
| 575 | :group 'allout) | ||
| 576 | ;;;_ = allout-run-unit-tests-on-load | ||
| 577 | (defcustom allout-run-unit-tests-on-load nil | ||
| 578 | "*When non-nil, unit tests will be run at end of loading the allout module. | ||
| 579 | |||
| 580 | Generally, allout code developers are the only ones who'll want to set this. | ||
| 581 | |||
| 582 | \(If set, this makes it an even better practice to exercise changes by | ||
| 583 | doing byte-compilation with a repeat count, so the file is loaded at the | ||
| 584 | of compilation.) | ||
| 585 | |||
| 586 | See `allout-run-unit-tests' to see what's run." | ||
| 587 | :type 'boolean | ||
| 588 | :group 'allout-developer) | ||
| 589 | |||
| 559 | ;;;_ + Miscellaneous customization | 590 | ;;;_ + Miscellaneous customization |
| 560 | 591 | ||
| 561 | ;;;_ = allout-command-prefix | 592 | ;;;_ = allout-command-prefix |
| @@ -615,6 +646,23 @@ unless optional third, non-nil element is present.") | |||
| 615 | ("=t" allout-latexify-exposed) | 646 | ("=t" allout-latexify-exposed) |
| 616 | ("=p" allout-flatten-exposed-to-buffer))) | 647 | ("=p" allout-flatten-exposed-to-buffer))) |
| 617 | 648 | ||
| 649 | ;;;_ = allout-inhibit-auto-fill | ||
| 650 | (defcustom allout-inhibit-auto-fill nil | ||
| 651 | "*If non-nil, auto-fill will be inhibited in the allout buffers. | ||
| 652 | |||
| 653 | You can customize this setting to set it for all allout buffers, or set it | ||
| 654 | in individual buffers if you want to inhibit auto-fill only in particular | ||
| 655 | buffers. \(You could use a function on `allout-mode-hook' to inhibit | ||
| 656 | auto-fill according, eg, to the major mode.\) | ||
| 657 | |||
| 658 | If you don't set this and auto-fill-mode is enabled, allout will use the | ||
| 659 | value that `normal-auto-fill-function', if any, when allout mode starts, or | ||
| 660 | else allout's special hanging-indent maintaining auto-fill function, | ||
| 661 | `allout-auto-fill'." | ||
| 662 | :type 'boolean | ||
| 663 | :group 'allout) | ||
| 664 | (make-variable-buffer-local 'allout-inhibit-auto-fill) | ||
| 665 | |||
| 618 | ;;;_ = allout-use-hanging-indents | 666 | ;;;_ = allout-use-hanging-indents |
| 619 | (defcustom allout-use-hanging-indents t | 667 | (defcustom allout-use-hanging-indents t |
| 620 | "*If non-nil, topic body text auto-indent defaults to indent of the header. | 668 | "*If non-nil, topic body text auto-indent defaults to indent of the header. |
| @@ -993,69 +1041,68 @@ activation. Being deprecated.") | |||
| 993 | "----" | 1041 | "----" |
| 994 | ["Set Header Lead" allout-reset-header-lead t] | 1042 | ["Set Header Lead" allout-reset-header-lead t] |
| 995 | ["Set New Exposure" allout-expose-topic t]))) | 1043 | ["Set New Exposure" allout-expose-topic t]))) |
| 996 | ;;;_ : Mode-Specific Variable Maintenance Utilities | 1044 | ;;;_ : Allout Modal-Variables Utilities |
| 997 | ;;;_ = allout-mode-prior-settings | 1045 | ;;;_ = allout-mode-prior-settings |
| 998 | (defvar allout-mode-prior-settings nil | 1046 | (defvar allout-mode-prior-settings nil |
| 999 | "Internal `allout-mode' use; settings to be resumed on mode deactivation.") | 1047 | "Internal `allout-mode' use; settings to be resumed on mode deactivation. |
| 1000 | (make-variable-buffer-local 'allout-mode-prior-settings) | ||
| 1001 | ;;;_ > allout-resumptions (name &optional value) | ||
| 1002 | (defun allout-resumptions (name &optional value) | ||
| 1003 | |||
| 1004 | "Registers or resumes settings over `allout-mode' activation/deactivation. | ||
| 1005 | |||
| 1006 | First arg is NAME of variable affected. Optional second arg is list | ||
| 1007 | containing allout-mode-specific VALUE to be imposed on named | ||
| 1008 | variable, and to be registered. \(It's a list so you can specify | ||
| 1009 | registrations of null values.) If no value is specified, the | ||
| 1010 | registered value is returned (encapsulated in the list, so the caller | ||
| 1011 | can distinguish nil vs no value), and the registration is popped | ||
| 1012 | from the list." | ||
| 1013 | |||
| 1014 | (let ((on-list (assq name allout-mode-prior-settings)) | ||
| 1015 | prior-capsule ; By `capsule' i mean a list | ||
| 1016 | ; containing a value, so we can | ||
| 1017 | ; distinguish nil from no value. | ||
| 1018 | ) | ||
| 1019 | |||
| 1020 | (if value | ||
| 1021 | 1048 | ||
| 1022 | ;; Registering: | 1049 | See `allout-add-resumptions' and `allout-do-resumptions'.") |
| 1023 | (progn | 1050 | (make-variable-buffer-local 'allout-mode-prior-settings) |
| 1024 | (if on-list | 1051 | ;;;_ > allout-add-resumptions (&rest pairs) |
| 1025 | nil ; Already preserved prior value - don't mess with it. | 1052 | (defun allout-add-resumptions (&rest pairs) |
| 1026 | ;; Register the old value, or nil if previously unbound: | 1053 | "Set name/value pairs. |
| 1027 | (setq allout-mode-prior-settings | 1054 | |
| 1028 | (cons (list name | 1055 | Old settings are preserved for later resumption using `allout-do-resumptions'. |
| 1029 | (if (boundp name) (list (symbol-value name)))) | 1056 | |
| 1030 | allout-mode-prior-settings))) | 1057 | The pairs are lists whose car is the name of the variable and car of the |
| 1031 | ; And impose the new value, locally: | 1058 | cdr is the new value: '(some-var some-value)'. |
| 1032 | (progn (make-local-variable name) | 1059 | |
| 1033 | (set name (car value)))) | 1060 | The new value is set as a buffer local. |
| 1034 | 1061 | ||
| 1035 | ;; Relinquishing: | 1062 | If the variable was not previously buffer-local, then that is noted and the |
| 1036 | (if (not on-list) | 1063 | `allout-do-resumptions' will just `kill-local-variable' of that binding. |
| 1037 | 1064 | ||
| 1038 | ;; Oops, not registered - leave it be: | 1065 | If it previously was buffer-local, the old value is noted and resurrected |
| 1039 | nil | 1066 | by `allout-do-resumptions'. \(If the local value was previously void, then |
| 1040 | 1067 | it is left as nil on resumption.\) | |
| 1041 | ;; Some registration: | 1068 | |
| 1042 | ; reestablish it: | 1069 | The settings are stored on `allout-mode-prior-settings'." |
| 1043 | (setq prior-capsule (car (cdr on-list))) | 1070 | (while pairs |
| 1044 | (if prior-capsule | 1071 | (let* ((pair (pop pairs)) |
| 1045 | (set name (car prior-capsule)) ; Some prior value - reestablish it. | 1072 | (name (car pair)) |
| 1046 | (makunbound name)) ; Previously unbound - demolish var. | 1073 | (value (cadr pair))) |
| 1047 | ; Remove registration: | 1074 | (if (not (symbolp name)) |
| 1048 | (let (rebuild) | 1075 | (error "Pair's name, %S, must be a symbol, not %s" |
| 1049 | (while allout-mode-prior-settings | 1076 | name (type-of name))) |
| 1050 | (if (not (eq (car allout-mode-prior-settings) | 1077 | (when (not (assoc name allout-mode-prior-settings)) |
| 1051 | on-list)) | 1078 | ;; Not already added as a resumption, create the prior setting entry. |
| 1052 | (setq rebuild | 1079 | (if (local-variable-p name) |
| 1053 | (cons (car allout-mode-prior-settings) | 1080 | ;; is already local variable - preserve the prior value: |
| 1054 | rebuild))) | 1081 | (push (list name (condition-case err |
| 1055 | (setq allout-mode-prior-settings | 1082 | (symbol-value name) |
| 1056 | (cdr allout-mode-prior-settings))) | 1083 | (void-variable nil))) |
| 1057 | (setq allout-mode-prior-settings rebuild))))) | 1084 | allout-mode-prior-settings) |
| 1058 | ) | 1085 | ;; wasn't local variable, indicate so for resumption by killing |
| 1086 | ;; local value, and make it local: | ||
| 1087 | (push (list name) allout-mode-prior-settings) | ||
| 1088 | (make-local-variable name))) | ||
| 1089 | (set name value)))) | ||
| 1090 | ;;;_ > allout-do-resumptions () | ||
| 1091 | (defun allout-do-resumptions () | ||
| 1092 | "Resume all name/value settings registered by `allout-add-resumptions'. | ||
| 1093 | |||
| 1094 | This is used when concluding allout-mode, to resume selected variables to | ||
| 1095 | their settings before allout-mode was started." | ||
| 1096 | |||
| 1097 | (while allout-mode-prior-settings | ||
| 1098 | (let* ((pair (pop allout-mode-prior-settings)) | ||
| 1099 | (name (car pair)) | ||
| 1100 | (value-cell (cdr pair))) | ||
| 1101 | (if (not value-cell) | ||
| 1102 | ;; Prior value was global: | ||
| 1103 | (kill-local-variable name) | ||
| 1104 | ;; Prior value was explicit: | ||
| 1105 | (set name (car value-cell)))))) | ||
| 1059 | ;;;_ : Mode-specific incidentals | 1106 | ;;;_ : Mode-specific incidentals |
| 1060 | ;;;_ > allout-unprotected (expr) | 1107 | ;;;_ > allout-unprotected (expr) |
| 1061 | (defmacro allout-unprotected (expr) | 1108 | (defmacro allout-unprotected (expr) |
| @@ -1065,9 +1112,12 @@ from the list." | |||
| 1065 | ;;;_ = allout-mode-hook | 1112 | ;;;_ = allout-mode-hook |
| 1066 | (defvar allout-mode-hook nil | 1113 | (defvar allout-mode-hook nil |
| 1067 | "*Hook that's run when allout mode starts.") | 1114 | "*Hook that's run when allout mode starts.") |
| 1068 | ;;;_ = allout-overlay-category | 1115 | ;;;_ = allout-mode-deactivate-hook |
| 1069 | (defvar allout-overlay-category nil | 1116 | (defvar allout-mode-deactivate-hook nil |
| 1070 | "Symbol for use in allout invisible-text overlays as the category.") | 1117 | "*Hook that's run when allout mode ends.") |
| 1118 | ;;;_ = allout-exposure-category | ||
| 1119 | (defvar allout-exposure-category nil | ||
| 1120 | "Symbol for use as allout invisible-text overlay category.") | ||
| 1071 | ;;;_ x allout-view-change-hook | 1121 | ;;;_ x allout-view-change-hook |
| 1072 | (defvar allout-view-change-hook nil | 1122 | (defvar allout-view-change-hook nil |
| 1073 | "*\(Deprecated\) Hook that's run after allout outline exposure changes. | 1123 | "*\(Deprecated\) Hook that's run after allout outline exposure changes. |
| @@ -1293,30 +1343,26 @@ the following two lines in your Emacs init file: | |||
| 1293 | (setq cur (car menus) | 1343 | (setq cur (car menus) |
| 1294 | menus (cdr menus)) | 1344 | menus (cdr menus)) |
| 1295 | (easy-menu-add cur)))) | 1345 | (easy-menu-add cur)))) |
| 1296 | ;;;_ > allout-set-overlay-category | 1346 | ;;;_ > allout-overlay-preparations |
| 1297 | (defun allout-set-overlay-category () | 1347 | (defun allout-overlay-preparations () |
| 1298 | "Set the properties of the allout invisible-text overlay." | 1348 | "Set the properties of the allout invisible-text overlay and others." |
| 1299 | (setplist 'allout-overlay-category nil) | 1349 | (setplist 'allout-exposure-category nil) |
| 1300 | (put 'allout-overlay-category 'invisible 'allout) | 1350 | (put 'allout-exposure-category 'invisible 'allout) |
| 1301 | (put 'allout-overlay-category 'evaporate t) | 1351 | (put 'allout-exposure-category 'evaporate t) |
| 1302 | ;; XXX We use isearch-open-invisible *and* isearch-mode-end-hook. The | 1352 | ;; XXX We use isearch-open-invisible *and* isearch-mode-end-hook. The |
| 1303 | ;; latter would be sufficient, but it seems that a separate behavior - | 1353 | ;; latter would be sufficient, but it seems that a separate behavior - |
| 1304 | ;; the _transient_ opening of invisible text during isearch - is keyed to | 1354 | ;; the _transient_ opening of invisible text during isearch - is keyed to |
| 1305 | ;; presence of the isearch-open-invisible property - even though this | 1355 | ;; presence of the isearch-open-invisible property - even though this |
| 1306 | ;; property controls the isearch _arrival_ behavior. This is the case at | 1356 | ;; property controls the isearch _arrival_ behavior. This is the case at |
| 1307 | ;; least in emacs 21, 22.0, and xemacs 21.4. | 1357 | ;; least in emacs 21, 22.0, and xemacs 21.4. |
| 1308 | (put 'allout-overlay-category 'isearch-open-invisible | 1358 | (put 'allout-exposure-category 'isearch-open-invisible |
| 1309 | 'allout-isearch-end-handler) | 1359 | 'allout-isearch-end-handler) |
| 1310 | (if (featurep 'xemacs) | 1360 | (if (featurep 'xemacs) |
| 1311 | (put 'allout-overlay-category 'start-open t) | 1361 | (put 'allout-exposure-category 'start-open t) |
| 1312 | (put 'allout-overlay-category 'insert-in-front-hooks | 1362 | (put 'allout-exposure-category 'insert-in-front-hooks |
| 1313 | '(allout-overlay-insert-in-front-handler))) | 1363 | '(allout-overlay-insert-in-front-handler))) |
| 1314 | (if (featurep 'xemacs) | 1364 | (put 'allout-exposure-category 'modification-hooks |
| 1315 | (progn (make-variable-buffer-local 'before-change-functions) | 1365 | '(allout-overlay-interior-modification-handler))) |
| 1316 | (add-hook 'before-change-functions | ||
| 1317 | 'allout-before-change-handler)) | ||
| 1318 | (put 'allout-overlay-category 'modification-hooks | ||
| 1319 | '(allout-overlay-interior-modification-handler)))) | ||
| 1320 | ;;;_ > allout-mode (&optional toggle) | 1366 | ;;;_ > allout-mode (&optional toggle) |
| 1321 | ;;;_ : Defun: | 1367 | ;;;_ : Defun: |
| 1322 | ;;;###autoload | 1368 | ;;;###autoload |
| @@ -1575,118 +1621,92 @@ OPEN: A topic that is not closed, though its offspring or body may be." | |||
| 1575 | ; active state or *de*activation | 1621 | ; active state or *de*activation |
| 1576 | ; specifically requested: | 1622 | ; specifically requested: |
| 1577 | (setq allout-explicitly-deactivated t) | 1623 | (setq allout-explicitly-deactivated t) |
| 1578 | (if (string-match "^18\." emacs-version) | ||
| 1579 | ; Revoke those keys that remain | ||
| 1580 | ; as we set them: | ||
| 1581 | (let ((curr-loc (current-local-map))) | ||
| 1582 | (mapcar (function | ||
| 1583 | (lambda (cell) | ||
| 1584 | (if (eq (lookup-key curr-loc (car cell)) | ||
| 1585 | (car (cdr cell))) | ||
| 1586 | (define-key curr-loc (car cell) | ||
| 1587 | (assq (car cell) allout-prior-bindings))))) | ||
| 1588 | allout-added-bindings) | ||
| 1589 | (allout-resumptions 'allout-added-bindings) | ||
| 1590 | (allout-resumptions 'allout-prior-bindings))) | ||
| 1591 | 1624 | ||
| 1592 | (if allout-old-style-prefixes | 1625 | (allout-do-resumptions) |
| 1593 | (progn | 1626 | |
| 1594 | (allout-resumptions 'allout-primary-bullet) | ||
| 1595 | (allout-resumptions 'allout-old-style-prefixes))) | ||
| 1596 | ;;(allout-resumptions 'selective-display) | ||
| 1597 | (remove-from-invisibility-spec '(allout . t)) | 1627 | (remove-from-invisibility-spec '(allout . t)) |
| 1598 | (set write-file-hook-var-name | 1628 | (remove-hook 'pre-command-hook 'allout-pre-command-business t) |
| 1599 | (delq 'allout-write-file-hook-handler | 1629 | (remove-hook 'post-command-hook 'allout-post-command-business t) |
| 1600 | (symbol-value write-file-hook-var-name))) | 1630 | (when (featurep 'xemacs) |
| 1601 | (setq auto-save-hook | 1631 | (remove-hook 'before-change-functions 'allout-before-change-handler t)) |
| 1602 | (delq 'allout-auto-save-hook-handler | 1632 | (remove-hook 'isearch-mode-end-hook 'allout-isearch-end-handler t) |
| 1603 | auto-save-hook)) | 1633 | (remove-hook write-file-hook-var-name 'allout-write-file-hook-handler t) |
| 1604 | (allout-resumptions 'paragraph-start) | 1634 | (remove-hook 'auto-save-hook 'allout-auto-save-hook-handler t) |
| 1605 | (allout-resumptions 'paragraph-separate) | 1635 | |
| 1606 | (allout-resumptions 'auto-fill-function) | 1636 | (remove-overlays (point-min) (point-max) |
| 1607 | (allout-resumptions 'normal-auto-fill-function) | 1637 | 'category 'allout-exposure-category) |
| 1608 | (allout-resumptions 'allout-former-auto-filler) | 1638 | |
| 1639 | (run-hooks 'allout-mode-deactivate-hook) | ||
| 1609 | (setq allout-mode nil)) | 1640 | (setq allout-mode nil)) |
| 1610 | 1641 | ||
| 1611 | ;; Activation: | 1642 | ;; Activation: |
| 1612 | ((not active) | 1643 | ((not active) |
| 1613 | (setq allout-explicitly-deactivated nil) | 1644 | (setq allout-explicitly-deactivated nil) |
| 1614 | (if allout-old-style-prefixes | 1645 | (if allout-old-style-prefixes |
| 1615 | (progn ; Inhibit all the fancy formatting: | 1646 | ;; Inhibit all the fancy formatting: |
| 1616 | (allout-resumptions 'allout-primary-bullet '("*")) | 1647 | (allout-add-resumptions '((allout-primary-bullet "*") |
| 1617 | (allout-resumptions 'allout-old-style-prefixes '(())))) | 1648 | (allout-old-style-prefixes ())))) |
| 1618 | 1649 | ||
| 1619 | (allout-set-overlay-category) ; Doesn't hurt to redo this. | 1650 | (allout-overlay-preparations) ; Doesn't hurt to redo this. |
| 1620 | 1651 | ||
| 1621 | (allout-infer-header-lead) | 1652 | (allout-infer-header-lead) |
| 1622 | (allout-infer-body-reindent) | 1653 | (allout-infer-body-reindent) |
| 1623 | 1654 | ||
| 1624 | (set-allout-regexp) | 1655 | (set-allout-regexp) |
| 1625 | 1656 | ||
| 1626 | ; Produce map from current version | 1657 | ;; Produce map from current version of allout-keybindings-list: |
| 1627 | ; of allout-keybindings-list: | 1658 | (setq allout-mode-map |
| 1628 | (if (boundp 'minor-mode-map-alist) | 1659 | (produce-allout-mode-map allout-keybindings-list)) |
| 1629 | 1660 | (substitute-key-definition 'beginning-of-line | |
| 1630 | (progn ; V19, and maybe lucid and | 1661 | 'move-beginning-of-line |
| 1631 | ; epoch, minor-mode key bindings: | 1662 | allout-mode-map global-map) |
| 1632 | (setq allout-mode-map | 1663 | (substitute-key-definition 'end-of-line |
| 1633 | (produce-allout-mode-map allout-keybindings-list)) | 1664 | 'move-end-of-line |
| 1634 | (substitute-key-definition 'beginning-of-line | 1665 | allout-mode-map global-map) |
| 1635 | 'move-beginning-of-line | 1666 | (produce-allout-mode-menubar-entries) |
| 1636 | allout-mode-map global-map) | 1667 | (fset 'allout-mode-map allout-mode-map) |
| 1637 | (substitute-key-definition 'end-of-line | 1668 | |
| 1638 | 'move-end-of-line | 1669 | ;; Include on minor-mode-map-alist, if not already there: |
| 1639 | allout-mode-map global-map) | 1670 | (if (not (member '(allout-mode . allout-mode-map) |
| 1640 | (produce-allout-mode-menubar-entries) | 1671 | minor-mode-map-alist)) |
| 1641 | (fset 'allout-mode-map allout-mode-map) | 1672 | (setq minor-mode-map-alist |
| 1642 | ; Include on minor-mode-map-alist, | 1673 | (cons '(allout-mode . allout-mode-map) |
| 1643 | ; if not already there: | 1674 | minor-mode-map-alist))) |
| 1644 | (if (not (member '(allout-mode . allout-mode-map) | ||
| 1645 | minor-mode-map-alist)) | ||
| 1646 | (setq minor-mode-map-alist | ||
| 1647 | (cons '(allout-mode . allout-mode-map) | ||
| 1648 | minor-mode-map-alist)))) | ||
| 1649 | |||
| 1650 | ; V18 minor-mode key bindings: | ||
| 1651 | ; Stash record of added bindings | ||
| 1652 | ; for later revocation: | ||
| 1653 | (allout-resumptions 'allout-added-bindings | ||
| 1654 | (list allout-keybindings-list)) | ||
| 1655 | (allout-resumptions 'allout-prior-bindings | ||
| 1656 | (list (current-local-map))) | ||
| 1657 | ; and add them: | ||
| 1658 | (use-local-map (produce-allout-mode-map allout-keybindings-list | ||
| 1659 | (current-local-map))) | ||
| 1660 | ) | ||
| 1661 | 1675 | ||
| 1662 | (add-to-invisibility-spec '(allout . t)) | 1676 | (add-to-invisibility-spec '(allout . t)) |
| 1663 | (make-local-variable 'line-move-ignore-invisible) | 1677 | (allout-add-resumptions '(line-move-ignore-invisible t)) |
| 1664 | (setq line-move-ignore-invisible t) | 1678 | (add-hook 'pre-command-hook 'allout-pre-command-business nil t) |
| 1665 | (add-hook 'pre-command-hook 'allout-pre-command-business) | 1679 | (add-hook 'post-command-hook 'allout-post-command-business nil t) |
| 1666 | (add-hook 'post-command-hook 'allout-post-command-business) | 1680 | (when (featurep 'xemacs) |
| 1667 | (add-hook 'isearch-mode-end-hook 'allout-isearch-end-handler) | 1681 | (add-hook 'before-change-functions 'allout-before-change-handler |
| 1668 | (add-hook write-file-hook-var-name 'allout-write-file-hook-handler) | 1682 | nil t)) |
| 1669 | (add-hook 'auto-save-hook 'allout-auto-save-hook-handler) | 1683 | (add-hook 'isearch-mode-end-hook 'allout-isearch-end-handler nil t) |
| 1670 | ; Custom auto-fill func, to support | 1684 | (add-hook write-file-hook-var-name 'allout-write-file-hook-handler |
| 1671 | ; respect for topic headline, | 1685 | nil t) |
| 1672 | ; hanging-indents, etc: | 1686 | (add-hook 'auto-save-hook 'allout-auto-save-hook-handler |
| 1673 | ;; Register prevailing fill func for use by allout-auto-fill: | 1687 | nil t) |
| 1674 | (allout-resumptions 'allout-former-auto-filler (list auto-fill-function)) | 1688 | |
| 1675 | ;; Register allout-auto-fill to be used if filling is active: | 1689 | ;; Stash auto-fill settings and adjust so custom allout auto-fill |
| 1676 | (allout-resumptions 'auto-fill-function '(allout-auto-fill)) | 1690 | ;; func will be used if auto-fill is active or activated. (The |
| 1677 | (allout-resumptions 'allout-outside-normal-auto-fill-function | 1691 | ;; custom func respects topic headline, maintains hanging-indents, |
| 1678 | (list normal-auto-fill-function)) | 1692 | ;; etc.) |
| 1679 | (allout-resumptions 'normal-auto-fill-function '(allout-auto-fill)) | 1693 | (if (and auto-fill-function (not allout-inhibit-auto-fill)) |
| 1680 | ;; Paragraphs are broken by topic headlines. | 1694 | ;; allout-auto-fill will use the stashed values and so forth. |
| 1681 | (make-local-variable 'paragraph-start) | 1695 | (allout-add-resumptions '(auto-fill-function allout-auto-fill))) |
| 1682 | (allout-resumptions 'paragraph-start | 1696 | (allout-add-resumptions (list 'allout-former-auto-filler |
| 1683 | (list (concat paragraph-start "\\|^\\(" | 1697 | auto-fill-function) |
| 1684 | allout-regexp "\\)"))) | 1698 | ;; Register allout-auto-fill to be used if |
| 1685 | (make-local-variable 'paragraph-separate) | 1699 | ;; filling is active: |
| 1686 | (allout-resumptions 'paragraph-separate | 1700 | (list 'allout-outside-normal-auto-fill-function |
| 1687 | (list (concat paragraph-separate "\\|^\\(" | 1701 | normal-auto-fill-function) |
| 1688 | allout-regexp "\\)"))) | 1702 | '(normal-auto-fill-function allout-auto-fill) |
| 1689 | 1703 | ;; Paragraphs are broken by topic headlines. | |
| 1704 | (list 'paragraph-start | ||
| 1705 | (concat paragraph-start "\\|^\\(" | ||
| 1706 | allout-regexp "\\)")) | ||
| 1707 | (list 'paragraph-separate | ||
| 1708 | (concat paragraph-separate "\\|^\\(" | ||
| 1709 | allout-regexp "\\)"))) | ||
| 1690 | (or (assq 'allout-mode minor-mode-alist) | 1710 | (or (assq 'allout-mode minor-mode-alist) |
| 1691 | (setq minor-mode-alist | 1711 | (setq minor-mode-alist |
| 1692 | (cons '(allout-mode " Allout") minor-mode-alist))) | 1712 | (cons '(allout-mode " Allout") minor-mode-alist))) |
| @@ -1702,8 +1722,9 @@ OPEN: A topic that is not closed, though its offspring or body may be." | |||
| 1702 | ;; Reactivation: | 1722 | ;; Reactivation: |
| 1703 | ((setq do-layout t) | 1723 | ((setq do-layout t) |
| 1704 | (allout-infer-body-reindent)) | 1724 | (allout-infer-body-reindent)) |
| 1705 | ) ; cond | 1725 | ) ;; end of activation-mode cases. |
| 1706 | 1726 | ||
| 1727 | ;; Do auto layout if warranted: | ||
| 1707 | (let ((use-layout (if (listp allout-layout) | 1728 | (let ((use-layout (if (listp allout-layout) |
| 1708 | allout-layout | 1729 | allout-layout |
| 1709 | allout-default-layout))) | 1730 | allout-default-layout))) |
| @@ -1802,9 +1823,14 @@ See allout-overlay-interior-modification-handler for details. | |||
| 1802 | 1823 | ||
| 1803 | This before-change handler is used only where modification-hooks | 1824 | This before-change handler is used only where modification-hooks |
| 1804 | overlay property is not supported." | 1825 | overlay property is not supported." |
| 1805 | (if (not (allout-mode-p)) | 1826 | ;; allout-overlay-interior-modification-handler on an overlay handles |
| 1806 | nil | 1827 | ;; this in other emacs, via `allout-exposure-category's 'modification-hooks. |
| 1807 | (allout-overlay-interior-modification-handler nil nil beg end nil))) | 1828 | (when (and (featurep 'xemacs) (allout-mode-p)) |
| 1829 | ;; process all of the pending overlays: | ||
| 1830 | (dolist (overlay (overlays-in beg end)) | ||
| 1831 | (if (eq (overlay-get ol 'invisible) 'allout) | ||
| 1832 | (allout-overlay-interior-modification-handler | ||
| 1833 | overlay nil beg end nil))))) | ||
| 1808 | ;;;_ > allout-isearch-end-handler (&optional overlay) | 1834 | ;;;_ > allout-isearch-end-handler (&optional overlay) |
| 1809 | (defun allout-isearch-end-handler (&optional overlay) | 1835 | (defun allout-isearch-end-handler (&optional overlay) |
| 1810 | "Reconcile allout outline exposure on arriving in hidden text after isearch. | 1836 | "Reconcile allout outline exposure on arriving in hidden text after isearch. |
| @@ -2018,12 +2044,12 @@ Outermost is first." | |||
| 2018 | (if (allout-hidden-p) (forward-char 1)))) | 2044 | (if (allout-hidden-p) (forward-char 1)))) |
| 2019 | ;;;_ > allout-next-heading () | 2045 | ;;;_ > allout-next-heading () |
| 2020 | (defsubst allout-next-heading () | 2046 | (defsubst allout-next-heading () |
| 2021 | "Move to the heading for the topic \(possibly invisible) before this one. | 2047 | "Move to the heading for the topic \(possibly invisible) after this one. |
| 2022 | 2048 | ||
| 2023 | Returns the location of the heading, or nil if none found." | 2049 | Returns the location of the heading, or nil if none found." |
| 2024 | 2050 | ||
| 2025 | (if (and (bobp) (not (eobp))) | 2051 | (if (and (bobp) (not (eobp)) (looking-at allout-regexp)) |
| 2026 | (forward-char 1)) | 2052 | (forward-char 1)) |
| 2027 | 2053 | ||
| 2028 | (if (re-search-forward allout-line-boundary-regexp nil 0) | 2054 | (if (re-search-forward allout-line-boundary-regexp nil 0) |
| 2029 | (allout-prefix-data ; Got valid location state - set vars: | 2055 | (allout-prefix-data ; Got valid location state - set vars: |
| @@ -2688,36 +2714,52 @@ return to regular interpretation of self-insert characters." | |||
| 2688 | 2714 | ||
| 2689 | (if (not (allout-mode-p)) | 2715 | (if (not (allout-mode-p)) |
| 2690 | nil | 2716 | nil |
| 2691 | ;; Hot-spot navigation provisions: | ||
| 2692 | (if (and (eq this-command 'self-insert-command) | 2717 | (if (and (eq this-command 'self-insert-command) |
| 2693 | (eq (point)(allout-current-bullet-pos))) | 2718 | (eq (point)(allout-current-bullet-pos))) |
| 2694 | (let* ((this-key-num (cond | 2719 | (allout-hotspot-key-handler)))) |
| 2695 | ((numberp last-command-char) | 2720 | ;;;_ > allout-hotspot-key-handler () |
| 2696 | last-command-char) | 2721 | (defun allout-hotspot-key-handler () |
| 2697 | ;; Only xemacs has characterp. | 2722 | "Catchall handling of key bindings in hot-spots. |
| 2698 | ((and (fboundp 'characterp) | 2723 | |
| 2699 | (apply 'characterp | 2724 | Translates unmodified keystrokes to corresponding allout commands, when |
| 2700 | (list last-command-char))) | 2725 | they would qualify if prefixed with the allout-command-prefix, and sets |
| 2701 | (apply 'char-to-int (list last-command-char))) | 2726 | this-command accordingly. |
| 2702 | (t 0))) | 2727 | |
| 2703 | mapped-binding) | 2728 | Returns the qualifying command, if any, else nil." |
| 2704 | (if (zerop this-key-num) | 2729 | (interactive) |
| 2705 | nil | 2730 | (let* ((key-num (cond ((numberp last-command-char) last-command-char) |
| 2706 | ; Map upper-register literals | 2731 | ;; for XEmacs character type: |
| 2707 | ; to lower register: | 2732 | ((and (fboundp 'characterp) |
| 2708 | (if (<= 96 this-key-num) | 2733 | (apply 'characterp (list last-command-char))) |
| 2709 | (setq this-key-num (- this-key-num 32))) | 2734 | (apply 'char-to-int (list last-command-char))) |
| 2710 | ; Check if we have a literal: | 2735 | (t 0))) |
| 2711 | (if (and (<= 64 this-key-num) | 2736 | mapped-binding |
| 2712 | (>= 96 this-key-num)) | 2737 | (on-bullet (eq (point) (allout-current-bullet-pos)))) |
| 2713 | (setq mapped-binding | 2738 | |
| 2714 | (lookup-key 'allout-mode-map | 2739 | (if (zerop key-num) |
| 2715 | (concat allout-command-prefix | 2740 | nil |
| 2716 | (char-to-string (- this-key-num | 2741 | |
| 2717 | 64)))))) | 2742 | (if (and (<= 33 key-num) |
| 2718 | (if mapped-binding | 2743 | (setq mapped-binding |
| 2719 | (setq allout-post-goto-bullet t | 2744 | (key-binding (concat allout-command-prefix |
| 2720 | this-command mapped-binding))))))) | 2745 | (char-to-string |
| 2746 | (if (and (<= 97 key-num) ; "a" | ||
| 2747 | (>= 122 key-num)) ; "z" | ||
| 2748 | (- key-num 96) key-num))) | ||
| 2749 | t))) | ||
| 2750 | ;; Qualified with the allout prefix - do hot-spot operation. | ||
| 2751 | (setq allout-post-goto-bullet t) | ||
| 2752 | ;; accept-defaults nil, or else we'll get allout-item-icon-key-handler. | ||
| 2753 | (setq mapped-binding (key-binding (char-to-string key-num)))) | ||
| 2754 | |||
| 2755 | (while (keymapp mapped-binding) | ||
| 2756 | (setq mapped-binding | ||
| 2757 | (lookup-key mapped-binding (read-key-sequence-vector nil t)))) | ||
| 2758 | |||
| 2759 | (if mapped-binding | ||
| 2760 | (setq allout-post-goto-bullet on-bullet | ||
| 2761 | this-command mapped-binding))))) | ||
| 2762 | |||
| 2721 | ;;;_ > allout-find-file-hook () | 2763 | ;;;_ > allout-find-file-hook () |
| 2722 | (defun allout-find-file-hook () | 2764 | (defun allout-find-file-hook () |
| 2723 | "Activate `allout-mode' on non-nil `allout-auto-activation', `allout-layout'. | 2765 | "Activate `allout-mode' on non-nil `allout-auto-activation', `allout-layout'. |
| @@ -3146,21 +3188,23 @@ topic prior to the current one." | |||
| 3146 | 3188 | ||
| 3147 | Maintains outline hanging topic indentation if | 3189 | Maintains outline hanging topic indentation if |
| 3148 | `allout-use-hanging-indents' is set." | 3190 | `allout-use-hanging-indents' is set." |
| 3149 | (let ((fill-prefix (if allout-use-hanging-indents | 3191 | |
| 3150 | ;; Check for topic header indentation: | 3192 | (when (not allout-inhibit-auto-fill) |
| 3151 | (save-excursion | 3193 | (let ((fill-prefix (if allout-use-hanging-indents |
| 3152 | (beginning-of-line) | 3194 | ;; Check for topic header indentation: |
| 3153 | (if (looking-at allout-regexp) | 3195 | (save-excursion |
| 3154 | ;; ... construct indentation to account for | 3196 | (beginning-of-line) |
| 3155 | ;; length of topic prefix: | 3197 | (if (looking-at allout-regexp) |
| 3156 | (make-string (progn (allout-end-of-prefix) | 3198 | ;; ... construct indentation to account for |
| 3157 | (current-column)) | 3199 | ;; length of topic prefix: |
| 3158 | ?\ ))))) | 3200 | (make-string (progn (allout-end-of-prefix) |
| 3159 | (use-auto-fill-function (or allout-outside-normal-auto-fill-function | 3201 | (current-column)) |
| 3160 | auto-fill-function | 3202 | ?\ ))))) |
| 3161 | 'do-auto-fill))) | 3203 | (use-auto-fill-function (or allout-outside-normal-auto-fill-function |
| 3162 | (if (or allout-former-auto-filler allout-use-hanging-indents) | 3204 | auto-fill-function |
| 3163 | (funcall use-auto-fill-function)))) | 3205 | 'do-auto-fill))) |
| 3206 | (if (or allout-former-auto-filler allout-use-hanging-indents) | ||
| 3207 | (funcall use-auto-fill-function))))) | ||
| 3164 | ;;;_ > allout-reindent-body (old-depth new-depth &optional number) | 3208 | ;;;_ > allout-reindent-body (old-depth new-depth &optional number) |
| 3165 | (defun allout-reindent-body (old-depth new-depth &optional number) | 3209 | (defun allout-reindent-body (old-depth new-depth &optional number) |
| 3166 | "Reindent body lines which were indented at OLD-DEPTH to NEW-DEPTH. | 3210 | "Reindent body lines which were indented at OLD-DEPTH to NEW-DEPTH. |
| @@ -3601,8 +3645,10 @@ when yank with allout-yank into an outline as a heading." | |||
| 3601 | (forward-char 1))) | 3645 | (forward-char 1))) |
| 3602 | 3646 | ||
| 3603 | (if collapsed | 3647 | (if collapsed |
| 3604 | (put-text-property beg (1+ beg) 'allout-was-collapsed t) | 3648 | (allout-unprotected |
| 3605 | (remove-text-properties beg (1+ beg) '(allout-was-collapsed t))) | 3649 | (put-text-property beg (1+ beg) 'allout-was-collapsed t)) |
| 3650 | (allout-unprotected | ||
| 3651 | (remove-text-properties beg (1+ beg) '(allout-was-collapsed t)))) | ||
| 3606 | (allout-unprotected (kill-region beg (point))) | 3652 | (allout-unprotected (kill-region beg (point))) |
| 3607 | (sit-for 0) | 3653 | (sit-for 0) |
| 3608 | (save-excursion | 3654 | (save-excursion |
| @@ -3834,12 +3880,12 @@ by pops to non-distinctive yanks. Bug..." | |||
| 3834 | 3880 | ||
| 3835 | Text is shown if flag is nil and hidden otherwise." | 3881 | Text is shown if flag is nil and hidden otherwise." |
| 3836 | ;; We use outline invisibility spec. | 3882 | ;; We use outline invisibility spec. |
| 3837 | (remove-overlays from to 'category 'allout-overlay-category) | 3883 | (remove-overlays from to 'category 'allout-exposure-category) |
| 3838 | (when flag | 3884 | (when flag |
| 3839 | (let ((o (make-overlay from to))) | 3885 | (let ((o (make-overlay from to))) |
| 3840 | (overlay-put o 'category 'allout-overlay-category) | 3886 | (overlay-put o 'category 'allout-exposure-category) |
| 3841 | (when (featurep 'xemacs) | 3887 | (when (featurep 'xemacs) |
| 3842 | (let ((props (symbol-plist 'allout-overlay-category))) | 3888 | (let ((props (symbol-plist 'allout-exposure-category))) |
| 3843 | (while props | 3889 | (while props |
| 3844 | (overlay-put o (pop props) (pop props))))))) | 3890 | (overlay-put o (pop props) (pop props))))))) |
| 3845 | (run-hooks 'allout-view-change-hook) | 3891 | (run-hooks 'allout-view-change-hook) |
| @@ -3860,9 +3906,9 @@ Text is shown if flag is nil and hidden otherwise." | |||
| 3860 | flag))) | 3906 | flag))) |
| 3861 | 3907 | ||
| 3862 | ;;;_ - Topic-specific | 3908 | ;;;_ - Topic-specific |
| 3863 | ;;;_ > allout-show-entry (&optional inclusive) | 3909 | ;;;_ > allout-show-entry () |
| 3864 | (defun allout-show-entry (&optional inclusive) | 3910 | (defun allout-show-entry () |
| 3865 | "Like `allout-show-current-entry', reveals entries nested in hidden topics. | 3911 | "Like `allout-show-current-entry', but reveals entries in hidden topics. |
| 3866 | 3912 | ||
| 3867 | This is a way to give restricted peek at a concealed locality without the | 3913 | This is a way to give restricted peek at a concealed locality without the |
| 3868 | expense of exposing its context, but can leave the outline with aberrant | 3914 | expense of exposing its context, but can leave the outline with aberrant |
| @@ -3977,7 +4023,6 @@ Useful for coherently exposing to a random point in a hidden region." | |||
| 3977 | t))) | 4023 | t))) |
| 3978 | ;;;_ > allout-show-current-entry (&optional arg) | 4024 | ;;;_ > allout-show-current-entry (&optional arg) |
| 3979 | (defun allout-show-current-entry (&optional arg) | 4025 | (defun allout-show-current-entry (&optional arg) |
| 3980 | |||
| 3981 | "Show body following current heading, or hide entry with universal argument." | 4026 | "Show body following current heading, or hide entry with universal argument." |
| 3982 | 4027 | ||
| 3983 | (interactive "P") | 4028 | (interactive "P") |
| @@ -5919,7 +5964,131 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." | |||
| 5919 | (isearch-repeat 'forward) | 5964 | (isearch-repeat 'forward) |
| 5920 | (isearch-mode t))) | 5965 | (isearch-mode t))) |
| 5921 | 5966 | ||
| 5922 | ;;;_ #11 Provide | 5967 | ;;;_ #11 Unit tests - this should be last item before "Provide" |
| 5968 | ;;;_ > allout-run-unit-tests () | ||
| 5969 | (defun allout-run-unit-tests () | ||
| 5970 | "Run the various allout unit tests." | ||
| 5971 | (message "Running allout tests...") | ||
| 5972 | (allout-test-resumptions) | ||
| 5973 | (message "Running allout tests... Done.") | ||
| 5974 | (sit-for .5)) | ||
| 5975 | ;;;_ : test resumptions: | ||
| 5976 | ;;;_ > allout-tests-obliterate-variable (name) | ||
| 5977 | (defun allout-tests-obliterate-variable (name) | ||
| 5978 | "Completely unbind variable with NAME." | ||
| 5979 | (if (local-variable-p name) (kill-local-variable name)) | ||
| 5980 | (while (boundp name) (makunbound name))) | ||
| 5981 | ;;;_ > allout-test-resumptions () | ||
| 5982 | (defvar allout-tests-globally-unbound nil | ||
| 5983 | "Fodder for allout resumptions tests - defvar just for byte compiler.") | ||
| 5984 | (defvar allout-tests-globally-true nil | ||
| 5985 | "Fodder for allout resumptions tests - defvar just just for byte compiler.") | ||
| 5986 | (defvar allout-tests-locally-true nil | ||
| 5987 | "Fodder for allout resumptions tests - defvar just for byte compiler.") | ||
| 5988 | (defun allout-test-resumptions () | ||
| 5989 | "Exercise allout resumptions." | ||
| 5990 | ;; for each resumption case, we also test that the right local/global | ||
| 5991 | ;; scopes are affected during resumption effects: | ||
| 5992 | |||
| 5993 | ;; ensure that previously unbound variables return to the unbound state. | ||
| 5994 | (with-temp-buffer | ||
| 5995 | (allout-tests-obliterate-variable 'allout-tests-globally-unbound) | ||
| 5996 | (allout-add-resumptions '(allout-tests-globally-unbound t)) | ||
| 5997 | (assert (not (default-boundp 'allout-tests-globally-unbound))) | ||
| 5998 | (assert (local-variable-p 'allout-tests-globally-unbound)) | ||
| 5999 | (assert (boundp 'allout-tests-globally-unbound)) | ||
| 6000 | (assert (equal allout-tests-globally-unbound t)) | ||
| 6001 | (allout-do-resumptions) | ||
| 6002 | (assert (not (local-variable-p 'allout-tests-globally-unbound))) | ||
| 6003 | (assert (not (boundp 'allout-tests-globally-unbound)))) | ||
| 6004 | |||
| 6005 | ;; ensure that variable with prior global value is resumed | ||
| 6006 | (with-temp-buffer | ||
| 6007 | (allout-tests-obliterate-variable 'allout-tests-globally-true) | ||
| 6008 | (setq allout-tests-globally-true t) | ||
| 6009 | (allout-add-resumptions '(allout-tests-globally-true nil)) | ||
| 6010 | (assert (equal (default-value 'allout-tests-globally-true) t)) | ||
| 6011 | (assert (local-variable-p 'allout-tests-globally-true)) | ||
| 6012 | (assert (equal allout-tests-globally-true nil)) | ||
| 6013 | (allout-do-resumptions) | ||
| 6014 | (assert (not (local-variable-p 'allout-tests-globally-true))) | ||
| 6015 | (assert (boundp 'allout-tests-globally-true)) | ||
| 6016 | (assert (equal allout-tests-globally-true t))) | ||
| 6017 | |||
| 6018 | ;; ensure that prior local value is resumed | ||
| 6019 | (with-temp-buffer | ||
| 6020 | (allout-tests-obliterate-variable 'allout-tests-locally-true) | ||
| 6021 | (set (make-local-variable 'allout-tests-locally-true) t) | ||
| 6022 | (assert (not (default-boundp 'allout-tests-locally-true)) | ||
| 6023 | nil (concat "Test setup mistake - variable supposed to" | ||
| 6024 | " not have global binding, but it does.")) | ||
| 6025 | (assert (local-variable-p 'allout-tests-locally-true) | ||
| 6026 | nil (concat "Test setup mistake - variable supposed to have" | ||
| 6027 | " local binding, but it lacks one.")) | ||
| 6028 | (allout-add-resumptions '(allout-tests-locally-true nil)) | ||
| 6029 | (assert (not (default-boundp 'allout-tests-locally-true))) | ||
| 6030 | (assert (local-variable-p 'allout-tests-locally-true)) | ||
| 6031 | (assert (equal allout-tests-locally-true nil)) | ||
| 6032 | (allout-do-resumptions) | ||
| 6033 | (assert (boundp 'allout-tests-locally-true)) | ||
| 6034 | (assert (local-variable-p 'allout-tests-locally-true)) | ||
| 6035 | (assert (equal allout-tests-locally-true t)) | ||
| 6036 | (assert (not (default-boundp 'allout-tests-locally-true)))) | ||
| 6037 | |||
| 6038 | ;; ensure that last of multiple resumptions holds, for various scopes. | ||
| 6039 | (with-temp-buffer | ||
| 6040 | (allout-tests-obliterate-variable 'allout-tests-globally-unbound) | ||
| 6041 | (allout-tests-obliterate-variable 'allout-tests-globally-true) | ||
| 6042 | (setq allout-tests-globally-true t) | ||
| 6043 | (allout-tests-obliterate-variable 'allout-tests-locally-true) | ||
| 6044 | (set (make-local-variable 'allout-tests-locally-true) t) | ||
| 6045 | (allout-add-resumptions '(allout-tests-globally-unbound t) | ||
| 6046 | '(allout-tests-globally-true nil) | ||
| 6047 | '(allout-tests-locally-true nil)) | ||
| 6048 | (allout-add-resumptions '(allout-tests-globally-unbound 2) | ||
| 6049 | '(allout-tests-globally-true 3) | ||
| 6050 | '(allout-tests-locally-true 4)) | ||
| 6051 | ;; reestablish many of the basic conditions are maintained after re-add: | ||
| 6052 | (assert (not (default-boundp 'allout-tests-globally-unbound))) | ||
| 6053 | (assert (local-variable-p 'allout-tests-globally-unbound)) | ||
| 6054 | (assert (equal allout-tests-globally-unbound 2)) | ||
| 6055 | (assert (default-boundp 'allout-tests-globally-true)) | ||
| 6056 | (assert (local-variable-p 'allout-tests-globally-true)) | ||
| 6057 | (assert (equal allout-tests-globally-true 3)) | ||
| 6058 | (assert (not (default-boundp 'allout-tests-locally-true))) | ||
| 6059 | (assert (local-variable-p 'allout-tests-locally-true)) | ||
| 6060 | (assert (equal allout-tests-locally-true 4)) | ||
| 6061 | (allout-do-resumptions) | ||
| 6062 | (assert (not (local-variable-p 'allout-tests-globally-unbound))) | ||
| 6063 | (assert (not (boundp 'allout-tests-globally-unbound))) | ||
| 6064 | (assert (not (local-variable-p 'allout-tests-globally-true))) | ||
| 6065 | (assert (boundp 'allout-tests-globally-true)) | ||
| 6066 | (assert (equal allout-tests-globally-true t)) | ||
| 6067 | (assert (boundp 'allout-tests-locally-true)) | ||
| 6068 | (assert (local-variable-p 'allout-tests-locally-true)) | ||
| 6069 | (assert (equal allout-tests-locally-true t)) | ||
| 6070 | (assert (not (default-boundp 'allout-tests-locally-true)))) | ||
| 6071 | |||
| 6072 | ;; ensure that deliberately unbinding registered variables doesn't foul things | ||
| 6073 | (with-temp-buffer | ||
| 6074 | (allout-tests-obliterate-variable 'allout-tests-globally-unbound) | ||
| 6075 | (allout-tests-obliterate-variable 'allout-tests-globally-true) | ||
| 6076 | (setq allout-tests-globally-true t) | ||
| 6077 | (allout-tests-obliterate-variable 'allout-tests-locally-true) | ||
| 6078 | (set (make-local-variable 'allout-tests-locally-true) t) | ||
| 6079 | (allout-add-resumptions '(allout-tests-globally-unbound t) | ||
| 6080 | '(allout-tests-globally-true nil) | ||
| 6081 | '(allout-tests-locally-true nil)) | ||
| 6082 | (allout-tests-obliterate-variable 'allout-tests-globally-unbound) | ||
| 6083 | (allout-tests-obliterate-variable 'allout-tests-globally-true) | ||
| 6084 | (allout-tests-obliterate-variable 'allout-tests-locally-true) | ||
| 6085 | (allout-do-resumptions)) | ||
| 6086 | ) | ||
| 6087 | ;;;_ % Run unit tests if `allout-run-unit-tests-after-load' is true: | ||
| 6088 | (when allout-run-unit-tests-on-load | ||
| 6089 | (allout-run-unit-tests)) | ||
| 6090 | |||
| 6091 | ;;;_ #12 Provide | ||
| 5923 | (provide 'allout) | 6092 | (provide 'allout) |
| 5924 | 6093 | ||
| 5925 | ;;;_* Local emacs vars. | 6094 | ;;;_* Local emacs vars. |