aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorEli Zaretskii2006-07-14 11:26:36 +0000
committerEli Zaretskii2006-07-14 11:26:36 +0000
commit01fc9422ddb1e7f1f47c1f58117cdb078d118711 (patch)
treef581c97cfdf665bf0a6c3325f1e8338583ea1ad6
parentdcc881213c9b7d6b6df11f394ce62f3a747c9ec5 (diff)
downloademacs-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/ChangeLog46
-rw-r--r--lisp/allout.el645
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 @@
12006-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
12006-07-14 K,Aa(Broly L,Bu(Brentey <lorentey@elte.hu> 472006-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
580Generally, 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
583doing byte-compilation with a repeat count, so the file is loaded at the
584of compilation.)
585
586See `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
653You can customize this setting to set it for all allout buffers, or set it
654in individual buffers if you want to inhibit auto-fill only in particular
655buffers. \(You could use a function on `allout-mode-hook' to inhibit
656auto-fill according, eg, to the major mode.\)
657
658If you don't set this and auto-fill-mode is enabled, allout will use the
659value that `normal-auto-fill-function', if any, when allout mode starts, or
660else 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
1006First arg is NAME of variable affected. Optional second arg is list
1007containing allout-mode-specific VALUE to be imposed on named
1008variable, and to be registered. \(It's a list so you can specify
1009registrations of null values.) If no value is specified, the
1010registered value is returned (encapsulated in the list, so the caller
1011can distinguish nil vs no value), and the registration is popped
1012from 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: 1049See `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 1055Old settings are preserved for later resumption using `allout-do-resumptions'.
1029 (if (boundp name) (list (symbol-value name)))) 1056
1030 allout-mode-prior-settings))) 1057The pairs are lists whose car is the name of the variable and car of the
1031 ; And impose the new value, locally: 1058cdr is the new value: '(some-var some-value)'.
1032 (progn (make-local-variable name) 1059
1033 (set name (car value)))) 1060The new value is set as a buffer local.
1034 1061
1035 ;; Relinquishing: 1062If 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: 1065If it previously was buffer-local, the old value is noted and resurrected
1039 nil 1066by `allout-do-resumptions'. \(If the local value was previously void, then
1040 1067it is left as nil on resumption.\)
1041 ;; Some registration: 1068
1042 ; reestablish it: 1069The 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
1094This is used when concluding allout-mode, to resume selected variables to
1095their 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
1803This before-change handler is used only where modification-hooks 1824This before-change handler is used only where modification-hooks
1804overlay property is not supported." 1825overlay 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
2023Returns the location of the heading, or nil if none found." 2049Returns 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 2724Translates unmodified keystrokes to corresponding allout commands, when
2700 (list last-command-char))) 2725they would qualify if prefixed with the allout-command-prefix, and sets
2701 (apply 'char-to-int (list last-command-char))) 2726this-command accordingly.
2702 (t 0))) 2727
2703 mapped-binding) 2728Returns 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
3147Maintains outline hanging topic indentation if 3189Maintains 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
3835Text is shown if flag is nil and hidden otherwise." 3881Text 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
3867This is a way to give restricted peek at a concealed locality without the 3913This is a way to give restricted peek at a concealed locality without the
3868expense of exposing its context, but can leave the outline with aberrant 3914expense 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.