aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorChong Yidong2006-09-14 17:52:07 +0000
committerChong Yidong2006-09-14 17:52:07 +0000
commitd83509985e17a19fe5771422d8620467a190e816 (patch)
tree89fc86aa82404b27a8080edc9e01dadb3cc2d0b5 /lisp
parentbcb0eabd9baa67b6ad6308c036ff4c00d3000213 (diff)
downloademacs-d83509985e17a19fe5771422d8620467a190e816.tar.gz
emacs-d83509985e17a19fe5771422d8620467a190e816.zip
* allout.el (allout-regexp, allout-line-boundary-regexp)
(allout-bob-regexp): Correct grouping and boundaries to fix backwards traversal. (allout-depth-specific-regexp, allout-depth-one-regexp): New versions that exploit \\{M\\} regexp syntax, to avoid geometric or worse time in allout-ascend. (allout-doublecheck-at-and-shallower): Identify depth threshold below which topics are checked for and disqualified by containment discontinuities. (allout-hotspot-key-handler): Correctly handle multiple-key strokes. Remove some unused variables. (allout-mode-leaders): Clarify that mode-specific comment-start will be used (set-allout-regexp): Correctly regexp-quote allout regexps to properly accept alternative header-leads and primary bullets with regexp-specific characters (eg, C "/*", mathematica "(*"). Include new regular expressions among those configured. (allout-infer-header-lead-and-primary-bullet): Rename allout-infer-header-lead. (allout-recent-depth): Manifest as a variable as well as a function. (allout-prefix-data): Simplify into an inline instead of a macro, assuming current match data rather than being explicitly passed it. Establish allout-recent-depth value as well as allout-recent-prefix-beginning and allout-recent-prefix-end. (allout-aberrant-container-p): True when an item's immediate offspring discontinuously contained. Useful for disqualifying unintended topic prefixes, likely at low depths. (allout-goto-prefix-doublechecked): Elaborated version of allout-goto-prefix which disqualifies aberrant pseudo-items. (allout-end-of-prefix, allout-pre-next-prefix) (allout-end-of-subtree): Disqualify aberrant containers. (allout-beginning-of-current-entry): Position at start of buffer when in container (depth 0) entry. (nullify-allout-prefix-data): Invalidate allout-recent-* prefix data. (allout-current-bullet): Strip text properties. (allout-get-prefix-bullet): Use right match groups. (allout-beginning-of-line, allout-next-heading): Disqualify aberrant containers. (allout-previous-heading): Disqualify aberrant containers. (allout-get-invisibility-overlay): Increment so progress is made when the first overlay is not the sought one. (allout-end-of-prefix): Disqualify aberrant containers. (allout-end-of-line): Cycle something like allout-beginning-of-line. (allout-mode): Make allout-old-style-prefixes (ie, enabling use with outline.el outlines) functional again. Change the primary bullet along with the header-lead - level 1 new-style bullets now work. Engage allout-before-change-handler in mainline emacs, not just xemacs, to do undo handling. (allout-before-change-handler): Expose undo changes occurring in hidden regions. Use allout-get-invisibility-overlay instead of reimplementing it inline. (allout-chart-subtree): Use start rather than end of prefix in charts. Use allout-recent-depth variable. (allout-chart-siblings): Disqualify aberrant topics. (allout-beginning-of-current-entry): Position correctly. (allout-ascend): Use new allout-depth-specific-regexp and allout-depth-one-regexp for linear instead of O(N^2) or worse behavior. (allout-ascend-to-depth, allout-up-current-level): Depend on allout-ascend, rather than reimplementing an algorithm. (allout-descend-to-depth): Use allout-recent-depth var instead of fun. (allout-next-sibling): On traversal of numerous intervening topics, resort to economical allout-next-sibling-leap. (allout-next-sibling-leap): Specialized version of allout-next-sibling that uses allout-ascend cleverly, to depend on a regexp search to leap large numbers of contained topics, rather than arbitrarily many one-by-one traversals. (allout-next-visible-heading): Disqualify aberrant topics. (allout-previous-visible-heading): Position consistently when interactive. (allout-forward-current-level): Base on allout-previous-sibling rather than reimplmenting the algorithm. Remove unused vars. (allout-solicit-alternate-bullet): Present default choice stripped of text properties. (allout-rebullet-heading): Use bullet stripped of text properties. Register changes using allout-exposure-change-hook. Disregard aberrant topics. (allout-shift-in): With universal-argument, make topic a peer of it's former offspring. Simplify the code by separating out allout-shift-out functionality. (allout-shift-out): With universal-argument, make offspring peers of their former container, and its siblings. Implement the functionality here, rather than inappropriately muddling the implementation of allout-shift-in. (allout-rebullet-topic): Respect additional argument for new parent-child separation function. (allout-yank-processing): Use allout-ascend directly. (allout-show-entry): Disqualify aberrant topics. (allout-show-children): Handle discontinuous children gracefully, extending the depth being revealed to expose them and posting a message indicating the situation. (allout-show-to-offshoot): Remove obsolete and incorrect comment. Leave cursor in correct position. (allout-hide-current-subtree): Use allout-ascend directly. Disqualify aberrant topics. (allout-kill-line, allout-kill-topic): Preserve exposure layout in a way that the yanks can restore it, as used to happen. (allout-yank-processing): Restore exposure layout as recorded by allout-kill-*, as used to happen. (allout-annotate-hidden, allout-hide-by-annotation): New routines for preseving and restoring exposure layout across kills. (allout-toggle-subtree-encryption): Run allout-exposure-change-hook. (allout-encrypt-string): Strip text properties. Rearranged order and outline-headings for some of the miscellaneous functions. (allout-resolve-xref): No need to quote the error name in the condition-case handler section. (allout-flatten): Classic recursive (and recursively intensive, without tail-recursion) list-flattener, needed by allout-shift-out when confronted with discontinuous children.
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog111
-rw-r--r--lisp/allout.el1273
2 files changed, 945 insertions, 439 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index fde192f0215..537d5063f88 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,114 @@
12006-09-005 Ken Manheimer <address@hidden>
2
3 * allout.el (allout-regexp, allout-line-boundary-regexp)
4 (allout-bob-regexp): Correct grouping and boundaries to fix
5 backwards traversal.
6 (allout-depth-specific-regexp, allout-depth-one-regexp): New
7 versions that exploit \\{M\\} regexp syntax, to avoid geometric or
8 worse time in allout-ascend.
9 (allout-doublecheck-at-and-shallower): Identify depth threshold
10 below which topics are checked for and disqualified by containment
11 discontinuities.
12 (allout-hotspot-key-handler): Correctly handle multiple-key
13 strokes. Remove some unused variables.
14 (allout-mode-leaders): Clarify that mode-specific comment-start
15 will be used
16 (set-allout-regexp): Correctly regexp-quote allout regexps to
17 properly accept alternative header-leads and primary bullets with
18 regexp-specific characters (eg, C "/*", mathematica "(*").
19 Include new regular expressions among those configured.
20 (allout-infer-header-lead-and-primary-bullet): Rename
21 allout-infer-header-lead.
22 (allout-recent-depth): Manifest as a variable as well as a function.
23 (allout-prefix-data): Simplify into an inline instead of a macro,
24 assuming current match data rather than being explicitly passed it.
25 Establish allout-recent-depth value as well as
26 allout-recent-prefix-beginning and allout-recent-prefix-end.
27 (allout-aberrant-container-p): True when an item's immediate
28 offspring discontinuously contained. Useful for disqualifying
29 unintended topic prefixes, likely at low depths.
30 (allout-goto-prefix-doublechecked): Elaborated version of
31 allout-goto-prefix which disqualifies aberrant pseudo-items.
32 (allout-end-of-prefix, allout-pre-next-prefix)
33 (allout-end-of-subtree): Disqualify aberrant containers.
34 (allout-beginning-of-current-entry): Position at start of buffer
35 when in container (depth 0) entry.
36 (nullify-allout-prefix-data): Invalidate allout-recent-* prefix data.
37 (allout-current-bullet): Strip text properties.
38 (allout-get-prefix-bullet): Use right match groups.
39 (allout-beginning-of-line, allout-next-heading): Disqualify
40 aberrant containers.
41 (allout-previous-heading): Disqualify aberrant containers.
42 (allout-get-invisibility-overlay): Increment so progress is made
43 when the first overlay is not the sought one.
44 (allout-end-of-prefix): Disqualify aberrant containers.
45 (allout-end-of-line): Cycle something like allout-beginning-of-line.
46 (allout-mode): Make allout-old-style-prefixes (ie, enabling use with
47 outline.el outlines) functional again. Change the primary bullet
48 along with the header-lead - level 1 new-style bullets now work.
49 Engage allout-before-change-handler in mainline emacs, not just
50 xemacs, to do undo handling.
51 (allout-before-change-handler): Expose undo changes occurring in
52 hidden regions. Use allout-get-invisibility-overlay instead of
53 reimplementing it inline.
54 (allout-chart-subtree): Use start rather than end of prefix in
55 charts. Use allout-recent-depth variable.
56 (allout-chart-siblings): Disqualify aberrant topics.
57 (allout-beginning-of-current-entry): Position correctly.
58 (allout-ascend): Use new allout-depth-specific-regexp and
59 allout-depth-one-regexp for linear instead of O(N^2) or worse behavior.
60 (allout-ascend-to-depth, allout-up-current-level): Depend on
61 allout-ascend, rather than reimplementing an algorithm.
62 (allout-descend-to-depth): Use allout-recent-depth var instead of fun.
63 (allout-next-sibling): On traversal of numerous intervening
64 topics, resort to economical allout-next-sibling-leap.
65 (allout-next-sibling-leap): Specialized version of
66 allout-next-sibling that uses allout-ascend cleverly, to depend on
67 a regexp search to leap large numbers of contained topics, rather
68 than arbitrarily many one-by-one traversals.
69 (allout-next-visible-heading): Disqualify aberrant topics.
70 (allout-previous-visible-heading): Position consistently when interactive.
71 (allout-forward-current-level): Base on allout-previous-sibling
72 rather than reimplmenting the algorithm. Remove unused vars.
73 (allout-solicit-alternate-bullet): Present default choice stripped
74 of text properties.
75 (allout-rebullet-heading): Use bullet stripped of text properties.
76 Register changes using allout-exposure-change-hook. Disregard
77 aberrant topics.
78 (allout-shift-in): With universal-argument, make topic a peer of
79 it's former offspring. Simplify the code by separating out
80 allout-shift-out functionality.
81 (allout-shift-out): With universal-argument, make offspring peers
82 of their former container, and its siblings. Implement the
83 functionality here, rather than inappropriately muddling the
84 implementation of allout-shift-in.
85 (allout-rebullet-topic): Respect additional argument for new
86 parent-child separation function.
87 (allout-yank-processing): Use allout-ascend directly.
88 (allout-show-entry): Disqualify aberrant topics.
89 (allout-show-children): Handle discontinuous children gracefully,
90 extending the depth being revealed to expose them and posting a
91 message indicating the situation.
92 (allout-show-to-offshoot): Remove obsolete and incorrect comment.
93 Leave cursor in correct position.
94 (allout-hide-current-subtree): Use allout-ascend directly.
95 Disqualify aberrant topics.
96 (allout-kill-line, allout-kill-topic): Preserve exposure layout in
97 a way that the yanks can restore it, as used to happen.
98 (allout-yank-processing): Restore exposure layout as recorded by
99 allout-kill-*, as used to happen.
100 (allout-annotate-hidden, allout-hide-by-annotation): New routines
101 for preseving and restoring exposure layout across kills.
102 (allout-toggle-subtree-encryption): Run allout-exposure-change-hook.
103 (allout-encrypt-string): Strip text properties.
104 Rearranged order and outline-headings for some of the
105 miscellaneous functions.
106 (allout-resolve-xref): No need to quote the error name in the
107 condition-case handler section.
108 (allout-flatten): Classic recursive (and recursively intensive,
109 without tail-recursion) list-flattener, needed by allout-shift-out
110 when confronted with discontinuous children.
111
12006-09-14 Chong Yidong <cyd@stupidchicken.com> 1122006-09-14 Chong Yidong <cyd@stupidchicken.com>
2 113
3 * startup.el (fancy-splash-text): Move editing instructions to 114 * startup.el (fancy-splash-text): Move editing instructions to
diff --git a/lisp/allout.el b/lisp/allout.el
index 379f664d092..f60f91bd636 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -847,18 +847,37 @@ and `allout-distinctive-bullets-string'.")
847(defvar allout-bullets-string-len 0 847(defvar allout-bullets-string-len 0
848 "Length of current buffers' `allout-plain-bullets-string'.") 848 "Length of current buffers' `allout-plain-bullets-string'.")
849(make-variable-buffer-local 'allout-bullets-string-len) 849(make-variable-buffer-local 'allout-bullets-string-len)
850;;;_ = allout-depth-specific-regexp
851(defvar allout-depth-specific-regexp ""
852 "*Regular expression to match a heading line prefix for a particular depth.
853
854This expression is used to search for depth-specific topic
855headers at depth 2 and greater. Use `allout-depth-one-regexp'
856for to seek topics at depth one.
857
858This var is set according to the user configuration vars by
859`set-allout-regexp'. It is prepared with format strings for two
860decimal numbers, which should each be one less than the depth of the
861topic prefix to be matched.")
862(make-variable-buffer-local 'allout-depth-specific-regexp)
863;;;_ = allout-depth-one-regexp
864(defvar allout-depth-one-regexp ""
865 "*Regular expression to match a heading line prefix for depth one.
866
867This var is set according to the user configuration vars by
868`set-allout-regexp'. It is prepared with format strings for two
869decimal numbers, which should each be one less than the depth of the
870topic prefix to be matched.")
871(make-variable-buffer-local 'allout-depth-one-regexp)
850;;;_ = allout-line-boundary-regexp 872;;;_ = allout-line-boundary-regexp
851(defvar allout-line-boundary-regexp () 873(defvar allout-line-boundary-regexp ()
852 "`allout-regexp' with outline style beginning-of-line anchor. 874 "`allout-regexp' with outline style beginning-of-line anchor.
853 875
854This is properly set when `allout-regexp' is produced by 876This is properly set by `set-allout-regexp'.")
855`set-allout-regexp', so that (match-beginning 2) and (match-end
8562) delimit the prefix.")
857(make-variable-buffer-local 'allout-line-boundary-regexp) 877(make-variable-buffer-local 'allout-line-boundary-regexp)
858;;;_ = allout-bob-regexp 878;;;_ = allout-bob-regexp
859(defvar allout-bob-regexp () 879(defvar allout-bob-regexp ()
860 "Like `allout-line-boundary-regexp', for headers at beginning of buffer. 880 "Like `allout-line-boundary-regexp', for headers at beginning of buffer.")
861\(match-beginning 2) and \(match-end 2) delimit the prefix.")
862(make-variable-buffer-local 'allout-bob-regexp) 881(make-variable-buffer-local 'allout-bob-regexp)
863;;;_ = allout-header-subtraction 882;;;_ = allout-header-subtraction
864(defvar allout-header-subtraction (1- (length allout-header-prefix)) 883(defvar allout-header-subtraction (1- (length allout-header-prefix))
@@ -869,7 +888,14 @@ This is properly set when `allout-regexp' is produced by
869 "Length of `allout-plain-bullets-string', updated by `set-allout-regexp'.") 888 "Length of `allout-plain-bullets-string', updated by `set-allout-regexp'.")
870(make-variable-buffer-local 'allout-plain-bullets-string-len) 889(make-variable-buffer-local 'allout-plain-bullets-string-len)
871 890
891;;;_ = allout-doublecheck-at-and-shallower
892(defconst allout-doublecheck-at-and-shallower 3
893 "Verify apparent topics of this depth and shallower as being non-aberrant.
872 894
895Verified with `allout-aberrant-container-p'. This check's usefulness is
896limited to shallow prospects, because the determination of aberrance
897depends on the mistaken item being followed by a legitimate item of
898excessively greater depth.")
873;;;_ X allout-reset-header-lead (header-lead) 899;;;_ X allout-reset-header-lead (header-lead)
874(defun allout-reset-header-lead (header-lead) 900(defun allout-reset-header-lead (header-lead)
875 "*Reset the leading string used to identify topic headers." 901 "*Reset the leading string used to identify topic headers."
@@ -961,7 +987,9 @@ file is programming code."
961 "Generate proper topic-header regexp form for outline functions. 987 "Generate proper topic-header regexp form for outline functions.
962 988
963Works with respect to `allout-plain-bullets-string' and 989Works with respect to `allout-plain-bullets-string' and
964`allout-distinctive-bullets-string'." 990`allout-distinctive-bullets-string'.
991
992Also refresh various data structures that hinge on the regexp."
965 993
966 (interactive) 994 (interactive)
967 ;; Derive allout-bullets-string from user configured components: 995 ;; Derive allout-bullets-string from user configured components:
@@ -996,19 +1024,84 @@ Works with respect to `allout-plain-bullets-string' and
996 ;; Derive next for repeated use in allout-pending-bullet: 1024 ;; Derive next for repeated use in allout-pending-bullet:
997 (setq allout-plain-bullets-string-len (length allout-plain-bullets-string)) 1025 (setq allout-plain-bullets-string-len (length allout-plain-bullets-string))
998 (setq allout-header-subtraction (1- (length allout-header-prefix))) 1026 (setq allout-header-subtraction (1- (length allout-header-prefix)))
999 ;; Produce the new allout-regexp: 1027
1000 (setq allout-regexp (concat "\\(" 1028 (let (new-part old-part)
1001 (regexp-quote allout-header-prefix) 1029 (setq new-part (concat "\\("
1002 "[ \t]*[" 1030 (regexp-quote allout-header-prefix)
1003 allout-bullets-string 1031 "[ \t]*"
1004 "]\\)\\|" 1032 ;; already regexp-quoted in a custom way:
1005 (regexp-quote allout-primary-bullet) 1033 "[" allout-bullets-string "]"
1006 "+\\|\^l")) 1034 "\\)")
1007 (setq allout-line-boundary-regexp 1035 old-part (concat "\\("
1008 (concat "\\(\n\\)\\(" allout-regexp "\\)")) 1036 (regexp-quote allout-primary-bullet)
1009 (setq allout-bob-regexp 1037 "\\|"
1010 (concat "\\(\\`\\)\\(" allout-regexp "\\)")) 1038 (regexp-quote allout-header-prefix)
1011 ) 1039 "\\)"
1040 "+"
1041 " ?[^" allout-primary-bullet "]")
1042 allout-regexp (concat new-part
1043 "\\|"
1044 old-part
1045 "\\|\^l")
1046
1047 allout-line-boundary-regexp (concat "\n" new-part
1048 "\\|"
1049 "\n" old-part)
1050
1051 allout-bob-regexp (concat "\\`" new-part
1052 "\\|"
1053 "\\`" old-part))
1054
1055 (setq allout-depth-specific-regexp
1056 (concat "\\(^\\|\\`\\)"
1057 "\\("
1058
1059 ;; new-style spacers-then-bullet string:
1060 "\\("
1061 (allout-format-quote (regexp-quote allout-header-prefix))
1062 " \\{%s\\}"
1063 "[" (allout-format-quote allout-bullets-string) "]"
1064 "\\)"
1065
1066 ;; old-style all-bullets string, if primary not multi-char:
1067 (if (< 0 allout-header-subtraction)
1068 ""
1069 (concat "\\|\\("
1070 (allout-format-quote
1071 (regexp-quote allout-primary-bullet))
1072 (allout-format-quote
1073 (regexp-quote allout-primary-bullet))
1074 (allout-format-quote
1075 (regexp-quote allout-primary-bullet))
1076 "\\{%s\\}"
1077 ;; disqualify greater depths:
1078 "[^"
1079 (allout-format-quote allout-primary-bullet)
1080 "]\\)"
1081 ))
1082 "\\)"
1083 ))
1084 (setq allout-depth-one-regexp
1085 (concat "\\(^\\|\\`\\)"
1086 "\\("
1087
1088 "\\("
1089 (regexp-quote allout-header-prefix)
1090 ;; disqualify any bullet char following any amount of
1091 ;; intervening whitespace:
1092 " *"
1093 (concat "[^ " allout-bullets-string "]")
1094 "\\)"
1095 (if (< 0 allout-header-subtraction)
1096 ;; Need not support anything like the old
1097 ;; bullet style if the prefix is multi-char.
1098 ""
1099 (concat "\\|"
1100 (regexp-quote allout-primary-bullet)
1101 ;; disqualify deeper primary-bullet sequences:
1102 "[^" allout-primary-bullet "]"))
1103 "\\)"
1104 ))))
1012;;;_ : Key bindings 1105;;;_ : Key bindings
1013;;;_ = allout-mode-map 1106;;;_ = allout-mode-map
1014(defvar allout-mode-map nil "Keybindings for (allout) outline minor mode.") 1107(defvar allout-mode-map nil "Keybindings for (allout) outline minor mode.")
@@ -1142,7 +1235,7 @@ The settings are stored on `allout-mode-prior-settings'."
1142 (if (not (symbolp name)) 1235 (if (not (symbolp name))
1143 (error "Pair's name, %S, must be a symbol, not %s" 1236 (error "Pair's name, %S, must be a symbol, not %s"
1144 name (type-of name))) 1237 name (type-of name)))
1145 (setq prior-value (condition-case err 1238 (setq prior-value (condition-case nil
1146 (symbol-value name) 1239 (symbol-value name)
1147 (void-variable nil))) 1240 (void-variable nil)))
1148 (when (not (assoc name allout-mode-prior-settings)) 1241 (when (not (assoc name allout-mode-prior-settings))
@@ -1792,8 +1885,7 @@ OPEN: A topic that is not closed, though its offspring or body may be."
1792 (remove-from-invisibility-spec '(allout . t)) 1885 (remove-from-invisibility-spec '(allout . t))
1793 (remove-hook 'pre-command-hook 'allout-pre-command-business t) 1886 (remove-hook 'pre-command-hook 'allout-pre-command-business t)
1794 (remove-hook 'post-command-hook 'allout-post-command-business t) 1887 (remove-hook 'post-command-hook 'allout-post-command-business t)
1795 (when (featurep 'xemacs) 1888 (remove-hook 'before-change-functions 'allout-before-change-handler t)
1796 (remove-hook 'before-change-functions 'allout-before-change-handler t))
1797 (remove-hook 'isearch-mode-end-hook 'allout-isearch-end-handler t) 1889 (remove-hook 'isearch-mode-end-hook 'allout-isearch-end-handler t)
1798 (remove-hook write-file-hook-var-name 'allout-write-file-hook-handler t) 1890 (remove-hook write-file-hook-var-name 'allout-write-file-hook-handler t)
1799 (remove-hook 'auto-save-hook 'allout-auto-save-hook-handler t) 1891 (remove-hook 'auto-save-hook 'allout-auto-save-hook-handler t)
@@ -1813,7 +1905,7 @@ OPEN: A topic that is not closed, though its offspring or body may be."
1813 1905
1814 (allout-overlay-preparations) ; Doesn't hurt to redo this. 1906 (allout-overlay-preparations) ; Doesn't hurt to redo this.
1815 1907
1816 (allout-infer-header-lead) 1908 (allout-infer-header-lead-and-primary-bullet)
1817 (allout-infer-body-reindent) 1909 (allout-infer-body-reindent)
1818 1910
1819 (set-allout-regexp) 1911 (set-allout-regexp)
@@ -1854,9 +1946,8 @@ OPEN: A topic that is not closed, though its offspring or body may be."
1854 (allout-add-resumptions '(line-move-ignore-invisible t)) 1946 (allout-add-resumptions '(line-move-ignore-invisible t))
1855 (add-hook 'pre-command-hook 'allout-pre-command-business nil t) 1947 (add-hook 'pre-command-hook 'allout-pre-command-business nil t)
1856 (add-hook 'post-command-hook 'allout-post-command-business nil t) 1948 (add-hook 'post-command-hook 'allout-post-command-business nil t)
1857 (when (featurep 'xemacs) 1949 (add-hook 'before-change-functions 'allout-before-change-handler
1858 (add-hook 'before-change-functions 'allout-before-change-handler 1950 nil t)
1859 nil t))
1860 (add-hook 'isearch-mode-end-hook 'allout-isearch-end-handler nil t) 1951 (add-hook 'isearch-mode-end-hook 'allout-isearch-end-handler nil t)
1861 (add-hook write-file-hook-var-name 'allout-write-file-hook-handler 1952 (add-hook write-file-hook-var-name 'allout-write-file-hook-handler
1862 nil t) 1953 nil t)
@@ -2000,14 +2091,19 @@ See allout-overlay-interior-modification-handler for details.
2000 2091
2001This before-change handler is used only where modification-hooks 2092This before-change handler is used only where modification-hooks
2002overlay property is not supported." 2093overlay property is not supported."
2094
2095 (if (and (allout-mode-p) undo-in-progress (allout-hidden-p))
2096 (allout-show-to-offshoot))
2097
2003 ;; allout-overlay-interior-modification-handler on an overlay handles 2098 ;; allout-overlay-interior-modification-handler on an overlay handles
2004 ;; this in other emacs, via `allout-exposure-category's 'modification-hooks. 2099 ;; this in other emacs, via `allout-exposure-category's 'modification-hooks.
2005 (when (and (featurep 'xemacs) (allout-mode-p)) 2100 (when (and (featurep 'xemacs) (allout-mode-p))
2006 ;; process all of the pending overlays: 2101 ;; process all of the pending overlays:
2007 (dolist (overlay (overlays-in beg end)) 2102 (save-excursion
2008 (if (eq (overlay-get ol 'invisible) 'allout) 2103 (got-char beg)
2009 (allout-overlay-interior-modification-handler 2104 (let ((overlay (allout-get-invisibility-overlay)))
2010 overlay nil beg end nil))))) 2105 (allout-overlay-interior-modification-handler
2106 overlay nil beg end nil)))))
2011;;;_ > allout-isearch-end-handler (&optional overlay) 2107;;;_ > allout-isearch-end-handler (&optional overlay)
2012(defun allout-isearch-end-handler (&optional overlay) 2108(defun allout-isearch-end-handler (&optional overlay)
2013 "Reconcile allout outline exposure on arriving in hidden text after isearch. 2109 "Reconcile allout outline exposure on arriving in hidden text after isearch.
@@ -2035,19 +2131,35 @@ function can also be used as an `isearch-mode-end-hook'."
2035(defvar allout-recent-prefix-end 0 2131(defvar allout-recent-prefix-end 0
2036 "Buffer point of the end of the last topic prefix encountered.") 2132 "Buffer point of the end of the last topic prefix encountered.")
2037(make-variable-buffer-local 'allout-recent-prefix-end) 2133(make-variable-buffer-local 'allout-recent-prefix-end)
2134;;;_ = allout-recent-depth
2135(defvar allout-recent-depth 0
2136 "Depth of the last topic prefix encountered.")
2137(make-variable-buffer-local 'allout-recent-depth)
2038;;;_ = allout-recent-end-of-subtree 2138;;;_ = allout-recent-end-of-subtree
2039(defvar allout-recent-end-of-subtree 0 2139(defvar allout-recent-end-of-subtree 0
2040 "Buffer point last returned by `allout-end-of-current-subtree'.") 2140 "Buffer point last returned by `allout-end-of-current-subtree'.")
2041(make-variable-buffer-local 'allout-recent-end-of-subtree) 2141(make-variable-buffer-local 'allout-recent-end-of-subtree)
2042;;;_ > allout-prefix-data (beg end) 2142;;;_ > allout-prefix-data ()
2043(defmacro allout-prefix-data (beg end) 2143(defsubst allout-prefix-data ()
2044 "Register allout-prefix state data - BEGINNING and END of prefix. 2144 "Register allout-prefix state data.
2045 2145
2046For reference by `allout-recent' funcs. Returns BEGINNING." 2146For reference by `allout-recent' funcs. Returns BEGINNING."
2047 `(setq allout-recent-prefix-end ,end 2147 (setq allout-recent-prefix-end (or (match-end 1) (match-end 2))
2048 allout-recent-prefix-beginning ,beg)) 2148 allout-recent-prefix-beginning (or (match-beginning 1)
2149 (match-beginning 2))
2150 allout-recent-depth (max 1 (- allout-recent-prefix-end
2151 allout-recent-prefix-beginning
2152 allout-header-subtraction)))
2153 allout-recent-prefix-beginning)
2154;;;_ > nullify-allout-prefix-data ()
2155(defsubst nullify-allout-prefix-data ()
2156 "Mark allout prefix data as being uninformative."
2157 (setq allout-recent-prefix-end (point)
2158 allout-recent-prefix-beginning (point)
2159 allout-recent-depth 0)
2160 allout-recent-prefix-beginning)
2049;;;_ > allout-recent-depth () 2161;;;_ > allout-recent-depth ()
2050(defmacro allout-recent-depth () 2162(defsubst allout-recent-depth ()
2051 "Return depth of last heading encountered by an outline maneuvering function. 2163 "Return depth of last heading encountered by an outline maneuvering function.
2052 2164
2053All outline functions which directly do string matches to assess 2165All outline functions which directly do string matches to assess
@@ -2055,19 +2167,17 @@ headings set the variables `allout-recent-prefix-beginning' and
2055`allout-recent-prefix-end' if successful. This function uses those settings 2167`allout-recent-prefix-end' if successful. This function uses those settings
2056to return the current depth." 2168to return the current depth."
2057 2169
2058 '(max 1 (- allout-recent-prefix-end 2170 allout-recent-depth)
2059 allout-recent-prefix-beginning
2060 allout-header-subtraction)))
2061;;;_ > allout-recent-prefix () 2171;;;_ > allout-recent-prefix ()
2062(defmacro allout-recent-prefix () 2172(defsubst allout-recent-prefix ()
2063 "Like `allout-recent-depth', but returns text of last encountered prefix. 2173 "Like `allout-recent-depth', but returns text of last encountered prefix.
2064 2174
2065All outline functions which directly do string matches to assess 2175All outline functions which directly do string matches to assess
2066headings set the variables `allout-recent-prefix-beginning' and 2176headings set the variables `allout-recent-prefix-beginning' and
2067`allout-recent-prefix-end' if successful. This function uses those settings 2177`allout-recent-prefix-end' if successful. This function uses those settings
2068to return the current depth." 2178to return the current prefix."
2069 '(buffer-substring allout-recent-prefix-beginning 2179 (buffer-substring-no-properties allout-recent-prefix-beginning
2070 allout-recent-prefix-end)) 2180 allout-recent-prefix-end))
2071;;;_ > allout-recent-bullet () 2181;;;_ > allout-recent-bullet ()
2072(defmacro allout-recent-bullet () 2182(defmacro allout-recent-bullet ()
2073 "Like allout-recent-prefix, but returns bullet of last encountered prefix. 2183 "Like allout-recent-prefix, but returns bullet of last encountered prefix.
@@ -2076,8 +2186,8 @@ All outline functions which directly do string matches to assess
2076headings set the variables `allout-recent-prefix-beginning' and 2186headings set the variables `allout-recent-prefix-beginning' and
2077`allout-recent-prefix-end' if successful. This function uses those settings 2187`allout-recent-prefix-end' if successful. This function uses those settings
2078to return the current depth of the most recently matched topic." 2188to return the current depth of the most recently matched topic."
2079 '(buffer-substring (1- allout-recent-prefix-end) 2189 '(buffer-substring-no-properties (1- allout-recent-prefix-end)
2080 allout-recent-prefix-end)) 2190 allout-recent-prefix-end))
2081 2191
2082;;;_ #4 Navigation 2192;;;_ #4 Navigation
2083 2193
@@ -2091,7 +2201,8 @@ Actually, returns prefix beginning point."
2091 (save-excursion 2201 (save-excursion
2092 (allout-beginning-of-current-line) 2202 (allout-beginning-of-current-line)
2093 (and (looking-at allout-regexp) 2203 (and (looking-at allout-regexp)
2094 (allout-prefix-data (match-beginning 0) (match-end 0))))) 2204 (not (allout-aberrant-container-p))
2205 (allout-prefix-data))))
2095;;;_ > allout-on-heading-p () 2206;;;_ > allout-on-heading-p ()
2096(defalias 'allout-on-heading-p 'allout-on-current-heading-p) 2207(defalias 'allout-on-heading-p 'allout-on-current-heading-p)
2097;;;_ > allout-e-o-prefix-p () 2208;;;_ > allout-e-o-prefix-p ()
@@ -2101,6 +2212,51 @@ Actually, returns prefix beginning point."
2101 (beginning-of-line)) 2212 (beginning-of-line))
2102 (looking-at allout-regexp)) 2213 (looking-at allout-regexp))
2103 (= (point)(save-excursion (allout-end-of-prefix)(point))))) 2214 (= (point)(save-excursion (allout-end-of-prefix)(point)))))
2215;;;_ > allout-aberrant-container-p ()
2216(defun allout-aberrant-container-p ()
2217 "True if topic, or next sibling with children, contains them discontinuously.
2218
2219Discontinuous means an immediate offspring that is nested more
2220than one level deeper than the topic.
2221
2222If topic has no offspring, then the next sibling with offspring will
2223determine whether or not this one is determined to be aberrant.
2224
2225If true, then the allout-recent-* settings are calibrated on the
2226offspring that qaulifies it as aberrant, ie with depth that
2227exceeds the topic by more than one."
2228
2229 ;; This is most clearly understood when considering standard-prefix-leader
2230 ;; low-level topics, which can all too easily match text not intended as
2231 ;; headers. For example, any line with a leading '.' or '*' and lacking a
2232 ;; following bullet qualifies without this protection. (A sequence of
2233 ;; them can occur naturally, eg a typical textual bullet list.) We
2234 ;; disqualify such low-level sequences when they are followed by a
2235 ;; discontinuously contained child, inferring that the sequences are not
2236 ;; actually connected with their prospective context.
2237
2238 (let ((depth (allout-depth))
2239 (start-point (point))
2240 done aberrant)
2241 (save-excursion
2242 (while (and (not done)
2243 (re-search-forward allout-line-boundary-regexp nil 0))
2244 (allout-prefix-data)
2245 (goto-char allout-recent-prefix-beginning)
2246 (cond
2247 ;; sibling - continue:
2248 ((eq allout-recent-depth depth))
2249 ;; first offspring is excessive - aberrant:
2250 ((> allout-recent-depth (1+ depth))
2251 (setq done t aberrant t))
2252 ;; next non-sibling is lower-depth - not aberrant:
2253 (t (setq done t)))))
2254 (if aberrant
2255 aberrant
2256 (goto-char start-point)
2257 ;; recalibrate allout-recent-*
2258 (allout-depth)
2259 nil)))
2104;;;_ : Location attributes 2260;;;_ : Location attributes
2105;;;_ > allout-depth () 2261;;;_ > allout-depth ()
2106(defun allout-depth () 2262(defun allout-depth ()
@@ -2113,10 +2269,10 @@ Like `allout-current-depth', but respects hidden as well as visible topics."
2113 (let ((start-point (point))) 2269 (let ((start-point (point)))
2114 (if (and (allout-goto-prefix) 2270 (if (and (allout-goto-prefix)
2115 (not (< start-point (point)))) 2271 (not (< start-point (point))))
2116 (allout-recent-depth) 2272 allout-recent-depth
2117 (progn 2273 (progn
2118 ;; Oops, no prefix, zero prefix data: 2274 ;; Oops, no prefix, nullify it:
2119 (allout-prefix-data (point)(point)) 2275 (nullify-allout-prefix-data)
2120 ;; ... and return 0: 2276 ;; ... and return 0:
2121 0))))) 2277 0)))))
2122;;;_ > allout-current-depth () 2278;;;_ > allout-current-depth ()
@@ -2149,10 +2305,10 @@ Return zero if point is not within any topic."
2149 (condition-case nil 2305 (condition-case nil
2150 (save-excursion 2306 (save-excursion
2151 (allout-back-to-current-heading) 2307 (allout-back-to-current-heading)
2152 (buffer-substring (- allout-recent-prefix-end 1) 2308 (buffer-substring-no-properties (- allout-recent-prefix-end 1)
2153 allout-recent-prefix-end)) 2309 allout-recent-prefix-end))
2154 ;; Quick and dirty provision, ostensibly for missing bullet: 2310 ;; Quick and dirty provision, ostensibly for missing bullet:
2155 ('args-out-of-range nil)) 2311 (args-out-of-range nil))
2156 ) 2312 )
2157;;;_ > allout-get-prefix-bullet (prefix) 2313;;;_ > allout-get-prefix-bullet (prefix)
2158(defun allout-get-prefix-bullet (prefix) 2314(defun allout-get-prefix-bullet (prefix)
@@ -2160,7 +2316,7 @@ Return zero if point is not within any topic."
2160 ;; Doesn't make sense if we're old-style prefixes, but this just 2316 ;; Doesn't make sense if we're old-style prefixes, but this just
2161 ;; oughtn't be called then, so forget about it... 2317 ;; oughtn't be called then, so forget about it...
2162 (if (string-match allout-regexp prefix) 2318 (if (string-match allout-regexp prefix)
2163 (substring prefix (1- (match-end 0)) (match-end 0)))) 2319 (substring prefix (1- (match-end 2)) (match-end 2))))
2164;;;_ > allout-sibling-index (&optional depth) 2320;;;_ > allout-sibling-index (&optional depth)
2165(defun allout-sibling-index (&optional depth) 2321(defun allout-sibling-index (&optional depth)
2166 "Item number of this prospective topic among its siblings. 2322 "Item number of this prospective topic among its siblings.
@@ -2174,10 +2330,10 @@ If less than this depth, ascend to that depth and count..."
2174 (cond ((and depth (<= depth 0) 0)) 2330 (cond ((and depth (<= depth 0) 0))
2175 ((or (not depth) (= depth (allout-depth))) 2331 ((or (not depth) (= depth (allout-depth)))
2176 (let ((index 1)) 2332 (let ((index 1))
2177 (while (allout-previous-sibling (allout-recent-depth) nil) 2333 (while (allout-previous-sibling allout-recent-depth nil)
2178 (setq index (1+ index))) 2334 (setq index (1+ index)))
2179 index)) 2335 index))
2180 ((< depth (allout-recent-depth)) 2336 ((< depth allout-recent-depth)
2181 (allout-ascend-to-depth depth) 2337 (allout-ascend-to-depth depth)
2182 (allout-sibling-index)) 2338 (allout-sibling-index))
2183 (0)))) 2339 (0))))
@@ -2229,11 +2385,17 @@ Outermost is first."
2229 (if (or (not allout-beginning-of-line-cycles) 2385 (if (or (not allout-beginning-of-line-cycles)
2230 (not (equal last-command this-command))) 2386 (not (equal last-command this-command)))
2231 (move-beginning-of-line 1) 2387 (move-beginning-of-line 1)
2232 (let ((beginning-of-body (save-excursion 2388 (allout-depth)
2233 (allout-beginning-of-current-entry) 2389 (let ((beginning-of-body
2234 (point)))) 2390 (save-excursion
2391 (while (and (<= allout-recent-depth
2392 allout-doublecheck-at-and-shallower)
2393 (allout-aberrant-container-p)
2394 (allout-previous-visible-heading 1)))
2395 (allout-beginning-of-current-entry)
2396 (point))))
2235 (cond ((= (current-column) 0) 2397 (cond ((= (current-column) 0)
2236 (allout-beginning-of-current-entry)) 2398 (goto-char beginning-of-body))
2237 ((< (point) beginning-of-body) 2399 ((< (point) beginning-of-body)
2238 (allout-beginning-of-current-line)) 2400 (allout-beginning-of-current-line))
2239 ((= (point) beginning-of-body) 2401 ((= (point) beginning-of-body)
@@ -2241,7 +2403,7 @@ Outermost is first."
2241 (t (allout-beginning-of-current-line) 2403 (t (allout-beginning-of-current-line)
2242 (if (< (point) beginning-of-body) 2404 (if (< (point) beginning-of-body)
2243 ;; we were on the headline after its start: 2405 ;; we were on the headline after its start:
2244 (allout-beginning-of-current-entry))))))) 2406 (goto-char beginning-of-body)))))))
2245;;;_ > allout-end-of-line () 2407;;;_ > allout-end-of-line ()
2246(defun allout-end-of-line () 2408(defun allout-end-of-line ()
2247 "End-of-line with `allout-end-of-line-cycles' behavior, if set." 2409 "End-of-line with `allout-end-of-line-cycles' behavior, if set."
@@ -2261,6 +2423,7 @@ Outermost is first."
2261 (allout-hidden-p))) 2423 (allout-hidden-p)))
2262 (allout-back-to-current-heading) 2424 (allout-back-to-current-heading)
2263 (allout-show-current-entry) 2425 (allout-show-current-entry)
2426 (allout-show-children)
2264 (allout-end-of-entry)) 2427 (allout-end-of-entry))
2265 ((>= (point) end-of-entry) 2428 ((>= (point) end-of-entry)
2266 (allout-back-to-current-heading) 2429 (allout-back-to-current-heading)
@@ -2270,40 +2433,47 @@ Outermost is first."
2270(defsubst allout-next-heading () 2433(defsubst allout-next-heading ()
2271 "Move to the heading for the topic \(possibly invisible) after this one. 2434 "Move to the heading for the topic \(possibly invisible) after this one.
2272 2435
2273Returns the location of the heading, or nil if none found." 2436Returns the location of the heading, or nil if none found.
2274 2437
2275 (if (and (bobp) (not (eobp)) (looking-at allout-regexp)) 2438We skip anomolous low-level topics, a la `allout-aberrant-container-p'."
2439 (if (looking-at allout-regexp)
2276 (forward-char 1)) 2440 (forward-char 1))
2277 2441
2278 (if (re-search-forward allout-line-boundary-regexp nil 0) 2442 (when (re-search-forward allout-line-boundary-regexp nil 0)
2279 (allout-prefix-data ; Got valid location state - set vars: 2443 (allout-prefix-data)
2280 (goto-char (or (match-beginning 2) 2444 (and (<= allout-recent-depth allout-doublecheck-at-and-shallower)
2281 allout-recent-prefix-beginning)) 2445 ;; register non-aberrant or disqualifying offspring as allout-recent-*
2282 (or (match-end 2) allout-recent-prefix-end)))) 2446 (allout-aberrant-container-p))
2447 (goto-char allout-recent-prefix-beginning)))
2283;;;_ > allout-this-or-next-heading 2448;;;_ > allout-this-or-next-heading
2284(defun allout-this-or-next-heading () 2449(defun allout-this-or-next-heading ()
2285 "Position cursor on current or next heading." 2450 "Position cursor on current or next heading."
2286 ;; A throwaway non-macro that is defined after allout-next-heading 2451 ;; A throwaway non-macro that is defined after allout-next-heading
2287 ;; and usable by allout-mode. 2452 ;; and usable by allout-mode.
2288 (if (not (allout-goto-prefix)) (allout-next-heading))) 2453 (if (not (allout-goto-prefix-doublechecked)) (allout-next-heading)))
2289;;;_ > allout-previous-heading () 2454;;;_ > allout-previous-heading ()
2290(defmacro allout-previous-heading () 2455(defsubst allout-previous-heading ()
2291 "Move to the prior \(possibly invisible) heading line. 2456 "Move to the prior \(possibly invisible) heading line.
2292 2457
2293Return the location of the beginning of the heading, or nil if not found." 2458Return the location of the beginning of the heading, or nil if not found.
2294 2459
2295 '(if (bobp) 2460We skip anomolous low-level topics, a la `allout-aberrant-container-p'."
2296 nil 2461
2297 (allout-goto-prefix) 2462 (if (bobp)
2298 (if 2463 nil
2299 ;; searches are unbounded and return nil if failed: 2464 ;; allout-goto-prefix-doublechecked calls us, so we can't use it here.
2300 (or (re-search-backward allout-line-boundary-regexp nil 0) 2465 (let ((start-point (point)))
2301 (looking-at allout-bob-regexp)) 2466 (allout-goto-prefix)
2302 (progn ; Got valid location state - set vars: 2467 (when (or (re-search-backward allout-line-boundary-regexp nil 0)
2303 (allout-prefix-data 2468 (looking-at allout-bob-regexp))
2304 (goto-char (or (match-beginning 2) 2469 (goto-char (allout-prefix-data))
2305 allout-recent-prefix-beginning)) 2470 (if (and (<= allout-recent-depth allout-doublecheck-at-and-shallower)
2306 (or (match-end 2) allout-recent-prefix-end)))))) 2471 (allout-aberrant-container-p))
2472 (or (allout-previous-heading)
2473 (goto-char start-point)
2474 ;; recalibrate allout-recent-*:
2475 (allout-depth)))
2476 (point)))))
2307;;;_ > allout-get-invisibility-overlay () 2477;;;_ > allout-get-invisibility-overlay ()
2308(defun allout-get-invisibility-overlay () 2478(defun allout-get-invisibility-overlay ()
2309 "Return the overlay at point that dictates allout invisibility." 2479 "Return the overlay at point that dictates allout invisibility."
@@ -2311,7 +2481,8 @@ Return the location of the beginning of the heading, or nil if not found."
2311 got) 2481 got)
2312 (while (and overlays (not got)) 2482 (while (and overlays (not got))
2313 (if (equal (overlay-get (car overlays) 'invisible) 'allout) 2483 (if (equal (overlay-get (car overlays) 'invisible) 'allout)
2314 (setq got (car overlays)))) 2484 (setq got (car overlays))
2485 (pop overlays)))
2315 got)) 2486 got))
2316;;;_ > allout-back-to-visible-text () 2487;;;_ > allout-back-to-visible-text ()
2317(defun allout-back-to-visible-text () 2488(defun allout-back-to-visible-text ()
@@ -2324,11 +2495,8 @@ Return the location of the beginning of the heading, or nil if not found."
2324;;;_ " These routines either produce or assess charts, which are 2495;;;_ " These routines either produce or assess charts, which are
2325;;; nested lists of the locations of topics within a subtree. 2496;;; nested lists of the locations of topics within a subtree.
2326;;; 2497;;;
2327;;; Use of charts enables efficient navigation of subtrees, by 2498;;; Charts enable efficient subtree navigation by providing a reusable basis
2328;;; requiring only a single regexp-search based traversal, to scope 2499;;; for elaborate, compound assessment and adjustment of a subtree.
2329;;; out the subtopic locations. The chart then serves as the basis
2330;;; for assessment or adjustment of the subtree, without redundant
2331;;; traversal of the structure.
2332 2500
2333;;;_ > allout-chart-subtree (&optional levels visible orig-depth prev-depth) 2501;;;_ > allout-chart-subtree (&optional levels visible orig-depth prev-depth)
2334(defun allout-chart-subtree (&optional levels visible orig-depth prev-depth) 2502(defun allout-chart-subtree (&optional levels visible orig-depth prev-depth)
@@ -2348,12 +2516,12 @@ Charts are used to capture outline structure, so that outline-altering
2348routines need assess the structure only once, and then use the chart 2516routines need assess the structure only once, and then use the chart
2349for their elaborate manipulations. 2517for their elaborate manipulations.
2350 2518
2351Topics are entered in the chart so the last one is at the car. 2519The chart entries for the topics are in reverse order, so the
2352The entry for each topic consists of an integer indicating the point 2520last topic is listed first. The entry for each topic consists of
2353at the beginning of the topic. Charts for offspring consists of a 2521an integer indicating the point at the beginning of the topic
2354list containing, recursively, the charts for the respective subtopics. 2522prefix. Charts for offspring consists of a list containing,
2355The chart for a topics' offspring precedes the entry for the topic 2523recursively, the charts for the respective subtopics. The chart
2356itself. 2524for a topics' offspring precedes the entry for the topic itself.
2357 2525
2358The other function parameters are for internal recursion, and should 2526The other function parameters are for internal recursion, and should
2359not be specified by external callers. ORIG-DEPTH is depth of topic at 2527not be specified by external callers. ORIG-DEPTH is depth of topic at
@@ -2380,17 +2548,17 @@ starting point, and PREV-DEPTH is depth of prior topic."
2380 2548
2381 (while (and (not (eobp)) 2549 (while (and (not (eobp))
2382 ; Still within original topic? 2550 ; Still within original topic?
2383 (< orig-depth (setq curr-depth (allout-recent-depth))) 2551 (< orig-depth (setq curr-depth allout-recent-depth))
2384 (cond ((= prev-depth curr-depth) 2552 (cond ((= prev-depth curr-depth)
2385 ;; Register this one and move on: 2553 ;; Register this one and move on:
2386 (setq chart (cons (point) chart)) 2554 (setq chart (cons allout-recent-prefix-beginning chart))
2387 (if (and levels (<= levels 1)) 2555 (if (and levels (<= levels 1))
2388 ;; At depth limit - skip sublevels: 2556 ;; At depth limit - skip sublevels:
2389 (or (allout-next-sibling curr-depth) 2557 (or (allout-next-sibling curr-depth)
2390 ;; or no more siblings - proceed to 2558 ;; or no more siblings - proceed to
2391 ;; next heading at lesser depth: 2559 ;; next heading at lesser depth:
2392 (while (and (<= curr-depth 2560 (while (and (<= curr-depth
2393 (allout-recent-depth)) 2561 allout-recent-depth)
2394 (if visible 2562 (if visible
2395 (allout-next-visible-heading 1) 2563 (allout-next-visible-heading 1)
2396 (allout-next-heading))))) 2564 (allout-next-heading)))))
@@ -2437,11 +2605,11 @@ starting point, and PREV-DEPTH is depth of prior topic."
2437Effectively a top-level chart of siblings. See `allout-chart-subtree' 2605Effectively a top-level chart of siblings. See `allout-chart-subtree'
2438for an explanation of charts." 2606for an explanation of charts."
2439 (save-excursion 2607 (save-excursion
2440 (if (allout-goto-prefix) 2608 (when (allout-goto-prefix-doublechecked)
2441 (let ((chart (list (point)))) 2609 (let ((chart (list (point))))
2442 (while (allout-next-sibling) 2610 (while (allout-next-sibling)
2443 (setq chart (cons (point) chart))) 2611 (setq chart (cons (point) chart)))
2444 (if chart (setq chart (nreverse chart))))))) 2612 (if chart (setq chart (nreverse chart)))))))
2445;;;_ > allout-chart-to-reveal (chart depth) 2613;;;_ > allout-chart-to-reveal (chart depth)
2446(defun allout-chart-to-reveal (chart depth) 2614(defun allout-chart-to-reveal (chart depth)
2447 2615
@@ -2514,15 +2682,25 @@ Returns the point at the beginning of the prefix, or nil if none."
2514 (search-backward "\n" nil 1)) 2682 (search-backward "\n" nil 1))
2515 (forward-char 1) 2683 (forward-char 1)
2516 (if (looking-at allout-regexp) 2684 (if (looking-at allout-regexp)
2517 (setq done (allout-prefix-data (match-beginning 0) 2685 (setq done (allout-prefix-data))
2518 (match-end 0)))
2519 (forward-char -1))) 2686 (forward-char -1)))
2520 (if (bobp) 2687 (if (bobp)
2521 (cond ((looking-at allout-regexp) 2688 (cond ((looking-at allout-regexp)
2522 (allout-prefix-data (match-beginning 0)(match-end 0))) 2689 (allout-prefix-data))
2523 ((allout-next-heading)) 2690 ((allout-next-heading))
2524 (done)) 2691 (done))
2525 done))) 2692 done)))
2693;;;_ > allout-goto-prefix-doublechecked ()
2694(defun allout-goto-prefix-doublechecked ()
2695 "Put point at beginning of immediately containing outline topic.
2696
2697Like `allout-goto-prefix', but shallow topics \(according to `allout-doublecheck-at-and-shallower') are checked and disqualified for child containment discontinuity, according to `allout-aberrant-container-p'."
2698 (allout-goto-prefix)
2699 (if (and (<= allout-recent-depth allout-doublecheck-at-and-shallower)
2700 (allout-aberrant-container-p))
2701 (allout-previous-heading)
2702 (point)))
2703
2526;;;_ > allout-end-of-prefix () 2704;;;_ > allout-end-of-prefix ()
2527(defun allout-end-of-prefix (&optional ignore-decorations) 2705(defun allout-end-of-prefix (&optional ignore-decorations)
2528 "Position cursor at beginning of header text. 2706 "Position cursor at beginning of header text.
@@ -2530,15 +2708,13 @@ Returns the point at the beginning of the prefix, or nil if none."
2530If optional IGNORE-DECORATIONS is non-nil, put just after bullet, 2708If optional IGNORE-DECORATIONS is non-nil, put just after bullet,
2531otherwise skip white space between bullet and ensuing text." 2709otherwise skip white space between bullet and ensuing text."
2532 2710
2533 (if (not (allout-goto-prefix)) 2711 (if (not (allout-goto-prefix-doublechecked))
2534 nil 2712 nil
2535 (let ((match-data (match-data))) 2713 (goto-char allout-recent-prefix-end)
2536 (goto-char (match-end 0)) 2714 (if ignore-decorations
2537 (if ignore-decorations 2715 t
2538 t 2716 (while (looking-at "[0-9]") (forward-char 1))
2539 (while (looking-at "[0-9]") (forward-char 1)) 2717 (if (and (not (eolp)) (looking-at "\\s-")) (forward-char 1)))
2540 (if (and (not (eolp)) (looking-at "\\s-")) (forward-char 1)))
2541 (store-match-data match-data))
2542 ;; Reestablish where we are: 2718 ;; Reestablish where we are:
2543 (allout-current-depth))) 2719 (allout-current-depth)))
2544;;;_ > allout-current-bullet-pos () 2720;;;_ > allout-current-bullet-pos ()
@@ -2547,7 +2723,7 @@ otherwise skip white space between bullet and ensuing text."
2547 2723
2548 (if (not (allout-current-depth)) 2724 (if (not (allout-current-depth))
2549 nil 2725 nil
2550 (1- (match-end 0)))) 2726 (1- allout-recent-prefix-end)))
2551;;;_ > allout-back-to-current-heading () 2727;;;_ > allout-back-to-current-heading ()
2552(defun allout-back-to-current-heading () 2728(defun allout-back-to-current-heading ()
2553 "Move to heading line of current topic, or beginning if already on the line. 2729 "Move to heading line of current topic, or beginning if already on the line.
@@ -2562,11 +2738,9 @@ in which case we return nil."
2562 (progn (while (allout-hidden-p) 2738 (progn (while (allout-hidden-p)
2563 (allout-beginning-of-current-line) 2739 (allout-beginning-of-current-line)
2564 (if (not (looking-at allout-regexp)) 2740 (if (not (looking-at allout-regexp))
2565 (re-search-backward (concat 2741 (re-search-backward allout-regexp
2566 "^\\(" allout-regexp "\\)")
2567 nil 'move))) 2742 nil 'move)))
2568 (allout-prefix-data (match-beginning 1) 2743 (allout-prefix-data))))
2569 (match-end 1)))))
2570 (if (interactive-p) 2744 (if (interactive-p)
2571 (allout-end-of-prefix) 2745 (allout-end-of-prefix)
2572 (point)))) 2746 (point))))
@@ -2579,8 +2753,7 @@ in which case we return nil."
2579Returns that character position." 2753Returns that character position."
2580 2754
2581 (if (re-search-forward allout-line-boundary-regexp nil 'move) 2755 (if (re-search-forward allout-line-boundary-regexp nil 'move)
2582 (prog1 (goto-char (match-beginning 0)) 2756 (goto-char (1- (allout-prefix-data)))))
2583 (allout-prefix-data (match-beginning 2)(match-end 2)))))
2584;;;_ > allout-end-of-subtree (&optional current include-trailing-blank) 2757;;;_ > allout-end-of-subtree (&optional current include-trailing-blank)
2585(defun allout-end-of-subtree (&optional current include-trailing-blank) 2758(defun allout-end-of-subtree (&optional current include-trailing-blank)
2586 "Put point at the end of the last leaf in the containing topic. 2759 "Put point at the end of the last leaf in the containing topic.
@@ -2596,11 +2769,11 @@ Returns the value of point."
2596 (interactive "P") 2769 (interactive "P")
2597 (if current 2770 (if current
2598 (allout-back-to-current-heading) 2771 (allout-back-to-current-heading)
2599 (allout-goto-prefix)) 2772 (allout-goto-prefix-doublechecked))
2600 (let ((level (allout-recent-depth))) 2773 (let ((level allout-recent-depth))
2601 (allout-next-heading) 2774 (allout-next-heading)
2602 (while (and (not (eobp)) 2775 (while (and (not (eobp))
2603 (> (allout-recent-depth) level)) 2776 (> allout-recent-depth level))
2604 (allout-next-heading)) 2777 (allout-next-heading))
2605 (if (eobp) 2778 (if (eobp)
2606 (allout-end-of-entry) 2779 (allout-end-of-entry)
@@ -2629,6 +2802,9 @@ If already there, move cursor to bullet for hot-spot operation.
2629 (interactive) 2802 (interactive)
2630 (let ((start-point (point))) 2803 (let ((start-point (point)))
2631 (move-beginning-of-line 1) 2804 (move-beginning-of-line 1)
2805 (if (< 0 (allout-current-depth))
2806 (goto-char allout-recent-prefix-end)
2807 (goto-char (point-min)))
2632 (allout-end-of-prefix) 2808 (allout-end-of-prefix)
2633 (if (and (interactive-p) 2809 (if (and (interactive-p)
2634 (= (point) start-point)) 2810 (= (point) start-point))
@@ -2676,17 +2852,12 @@ collapsed."
2676(defun allout-ascend-to-depth (depth) 2852(defun allout-ascend-to-depth (depth)
2677 "Ascend to depth DEPTH, returning depth if successful, nil if not." 2853 "Ascend to depth DEPTH, returning depth if successful, nil if not."
2678 (if (and (> depth 0)(<= depth (allout-depth))) 2854 (if (and (> depth 0)(<= depth (allout-depth)))
2679 (let ((last-good (point))) 2855 (let (last-ascended)
2680 (while (and (< depth (allout-depth)) 2856 (while (and (< depth allout-recent-depth)
2681 (setq last-good (point)) 2857 (setq last-ascended (allout-ascend))))
2682 (allout-beginning-of-level) 2858 (goto-char allout-recent-prefix-beginning)
2683 (allout-previous-heading))) 2859 (if (interactive-p) (allout-end-of-prefix))
2684 (if (= (allout-recent-depth) depth) 2860 (and last-ascended allout-recent-depth))))
2685 (progn (goto-char allout-recent-prefix-beginning)
2686 depth)
2687 (goto-char last-good)
2688 nil))
2689 (if (interactive-p) (allout-end-of-prefix))))
2690;;;_ > allout-ascend () 2861;;;_ > allout-ascend ()
2691(defun allout-ascend () 2862(defun allout-ascend ()
2692 "Ascend one level, returning t if successful, nil if not." 2863 "Ascend one level, returning t if successful, nil if not."
@@ -2703,49 +2874,24 @@ Returning depth if successful, nil if not."
2703 (start-depth (allout-depth))) 2874 (start-depth (allout-depth)))
2704 (while 2875 (while
2705 (and (> (allout-depth) 0) 2876 (and (> (allout-depth) 0)
2706 (not (= depth (allout-recent-depth))) ; ... not there yet 2877 (not (= depth allout-recent-depth)) ; ... not there yet
2707 (allout-next-heading) ; ... go further 2878 (allout-next-heading) ; ... go further
2708 (< start-depth (allout-recent-depth)))) ; ... still in topic 2879 (< start-depth allout-recent-depth))) ; ... still in topic
2709 (if (and (> (allout-depth) 0) 2880 (if (and (> (allout-depth) 0)
2710 (= (allout-recent-depth) depth)) 2881 (= allout-recent-depth depth))
2711 depth 2882 depth
2712 (goto-char start-point) 2883 (goto-char start-point)
2713 nil)) 2884 nil))
2714 ) 2885 )
2715;;;_ > allout-up-current-level (arg &optional dont-complain) 2886;;;_ > allout-up-current-level (arg)
2716(defun allout-up-current-level (arg &optional dont-complain) 2887(defun allout-up-current-level (arg)
2717 "Move out ARG levels from current visible topic. 2888 "Move out ARG levels from current visible topic."
2718
2719Positions on heading line of containing topic. Error if unable to
2720ascend that far, or nil if unable to ascend but optional arg
2721DONT-COMPLAIN is non-nil."
2722 (interactive "p") 2889 (interactive "p")
2723 (allout-back-to-current-heading) 2890 (allout-back-to-current-heading)
2724 (let ((present-level (allout-recent-depth)) 2891 (if (not (allout-ascend))
2725 (last-good (point)) 2892 (error "Can't ascend past outermost level")
2726 failed) 2893 (if (interactive-p) (allout-end-of-prefix))
2727 ;; Loop for iterating arg: 2894 allout-recent-prefix-beginning))
2728 (while (and (> (allout-recent-depth) 1)
2729 (> arg 0)
2730 (not (bobp))
2731 (not failed))
2732 (setq last-good (point))
2733 ;; Loop for going back over current or greater depth:
2734 (while (and (not (< (allout-recent-depth) present-level))
2735 (or (allout-previous-visible-heading 1)
2736 (not (setq failed present-level)))))
2737 (setq present-level (allout-current-depth))
2738 (setq arg (- arg 1)))
2739 (if (or failed
2740 (> arg 0))
2741 (progn (goto-char last-good)
2742 (if (interactive-p) (allout-end-of-prefix))
2743 (if (not dont-complain)
2744 (error "Can't ascend past outermost level")
2745 (if (interactive-p) (allout-end-of-prefix))
2746 nil))
2747 (if (interactive-p) (allout-end-of-prefix))
2748 allout-recent-prefix-beginning)))
2749 2895
2750;;;_ - Linear 2896;;;_ - Linear
2751;;;_ > allout-next-sibling (&optional depth backward) 2897;;;_ > allout-next-sibling (&optional depth backward)
@@ -2756,24 +2902,101 @@ Traverse at optional DEPTH, or current depth if none specified.
2756 2902
2757Go backward if optional arg BACKWARD is non-nil. 2903Go backward if optional arg BACKWARD is non-nil.
2758 2904
2759Return depth if successful, nil otherwise." 2905Return the start point of the new topic if successful, nil otherwise."
2760 2906
2761 (if (and backward (bobp)) 2907 (if (if backward (bobp) (eobp))
2762 nil 2908 nil
2763 (let ((start-depth (or depth (allout-depth))) 2909 (let ((target-depth (or depth (allout-depth)))
2764 (start-point (point)) 2910 (start-point (point))
2911 (count 0)
2912 leaping
2765 last-depth) 2913 last-depth)
2766 (while (and (not (if backward (bobp) (eobp))) 2914 (while (and
2767 (if backward (allout-previous-heading) 2915 ;; done too few single steps to resort to the leap routine:
2768 (allout-next-heading)) 2916 (not leaping)
2769 (> (setq last-depth (allout-recent-depth)) start-depth))) 2917 ;; not at limit:
2770 (if (and (not (eobp)) 2918 (not (if backward (bobp) (eobp)))
2771 (and (> (or last-depth (allout-depth)) 0) 2919 ;; still traversable:
2772 (= (allout-recent-depth) start-depth))) 2920 (if backward (allout-previous-heading) (allout-next-heading))
2773 allout-recent-prefix-beginning 2921 ;; we're below the target depth
2774 (goto-char start-point) 2922 (> (setq last-depth allout-recent-depth) target-depth))
2775 (if depth (allout-depth) start-depth) 2923 (setq count (1+ count))
2776 nil)))) 2924 (if (> count 7) ; lists are commonly 7 +- 2, right?-)
2925 (setq leaping t)))
2926 (cond (leaping
2927 (or (allout-next-sibling-leap target-depth backward)
2928 (progn
2929 (goto-char start-point)
2930 (if depth (allout-depth) target-depth)
2931 nil)))
2932 ((and (not (eobp))
2933 (and (> (or last-depth (allout-depth)) 0)
2934 (= allout-recent-depth target-depth)))
2935 allout-recent-prefix-beginning)
2936 (t
2937 (goto-char start-point)
2938 (if depth (allout-depth) target-depth)
2939 nil)))))
2940;;;_ > allout-next-sibling-leap (&optional depth backward)
2941(defun allout-next-sibling-leap (&optional depth backward)
2942 "Like `allout-next-sibling', but by direct search for topic at depth.
2943
2944Traverse at optional DEPTH, or current depth if none specified.
2945
2946Go backward if optional arg BACKWARD is non-nil.
2947
2948Return the start point of the new topic if successful, nil otherwise.
2949
2950Costs more than regular `allout-next-sibling' for short traversals:
2951
2952 - we have to check the prior \(next, if travelling backwards)
2953 item to confirm connectivity with the prior topic, and
2954 - if confirmed, we have to reestablish the allout-recent-* settings with
2955 some extra navigation
2956 - if confirmation fails, we have to do more work to recover
2957
2958It is an increasingly big win when there are many intervening
2959offspring before the next sibling, however, so
2960`allout-next-sibling' resorts to this if it finds itself in that
2961situation."
2962
2963 (if (if backward (bobp) (eobp))
2964 nil
2965 (let* ((start-point (point))
2966 (target-depth (or depth (allout-depth)))
2967 (search-whitespace-regexp nil)
2968 (depth-biased (- target-depth 2))
2969 (expression (if (<= target-depth 1)
2970 allout-depth-one-regexp
2971 (format allout-depth-specific-regexp
2972 depth-biased depth-biased)))
2973 found
2974 done)
2975 (while (not done)
2976 (setq found (if backward
2977 (re-search-backward expression nil 'to-limit)
2978 (forward-char 1)
2979 (re-search-forward expression nil 'to-limit)))
2980 (if (and found (allout-aberrant-container-p))
2981 (setq found nil))
2982 (setq done (or found (if backward (bobp) (eobp)))))
2983 (if (not found)
2984 (progn (goto-char start-point)
2985 nil)
2986 ;; rationale: if any intervening items were at a lower depth, we
2987 ;; would now be on the first offspring at the target depth - ie,
2988 ;; the preceeding item (per the search direction) must be at a
2989 ;; lesser depth. that's all we need to check.
2990 (if backward (allout-next-heading) (allout-previous-heading))
2991 (if (< allout-recent-depth target-depth)
2992 ;; return to start and reestablish allout-recent-*:
2993 (progn
2994 (goto-char start-point)
2995 (allout-depth)
2996 nil)
2997 (goto-char found)
2998 ;; locate cursor and set allout-recent-*:
2999 (allout-goto-prefix))))))
2777;;;_ > allout-previous-sibling (&optional depth backward) 3000;;;_ > allout-previous-sibling (&optional depth backward)
2778(defun allout-previous-sibling (&optional depth backward) 3001(defun allout-previous-sibling (&optional depth backward)
2779 "Like `allout-forward-current-level' backwards, respecting invisible topics. 3002 "Like `allout-forward-current-level' backwards, respecting invisible topics.
@@ -2807,7 +3030,7 @@ Presumes point is at the start of a topic prefix."
2807 3030
2808 (let ((depth (allout-depth))) 3031 (let ((depth (allout-depth)))
2809 (while (allout-previous-sibling depth nil)) 3032 (while (allout-previous-sibling depth nil))
2810 (prog1 (allout-recent-depth) 3033 (prog1 allout-recent-depth
2811 (if (interactive-p) (allout-end-of-prefix))))) 3034 (if (interactive-p) (allout-end-of-prefix)))))
2812;;;_ > allout-next-visible-heading (arg) 3035;;;_ > allout-next-visible-heading (arg)
2813(defun allout-next-visible-heading (arg) 3036(defun allout-next-visible-heading (arg)
@@ -2821,21 +3044,36 @@ Move to buffer limit in indicated direction if headings are exhausted."
2821 (step (if backward -1 1)) 3044 (step (if backward -1 1))
2822 prev got) 3045 prev got)
2823 3046
2824 (while (> arg 0) ; limit condition 3047 (while (> arg 0)
2825 (while (and (not (if backward (bobp)(eobp))) ; boundary condition 3048 (while (and
2826 ;; Move, skipping over all those concealed lines: 3049 ;; Boundary condition:
2827 (prog1 (condition-case nil (or (line-move step) t) 3050 (not (if backward (bobp)(eobp)))
2828 (error nil)) 3051 ;; Move, skipping over all concealed lines in one fell swoop:
2829 (allout-beginning-of-current-line)) 3052 (prog1 (condition-case nil (or (line-move step) t)
2830 (not (setq got (looking-at allout-regexp))))) 3053 (error nil))
3054 (allout-beginning-of-current-line))
3055 ;; Deal with apparent header line:
3056 (if (not (looking-at allout-regexp))
3057 ;; not a header line, keep looking:
3058 t
3059 (allout-prefix-data)
3060 (if (and (<= allout-recent-depth
3061 allout-doublecheck-at-and-shallower)
3062 (allout-aberrant-container-p))
3063 ;; skip this aberrant prospective header line:
3064 t
3065 ;; this prospective headerline qualifies - register:
3066 (setq got allout-recent-prefix-beginning)
3067 ;; and break the loop:
3068 nil))))
2831 ;; Register this got, it may be the last: 3069 ;; Register this got, it may be the last:
2832 (if got (setq prev got)) 3070 (if got (setq prev got))
2833 (setq arg (1- arg))) 3071 (setq arg (1- arg)))
2834 (cond (got ; Last move was to a prefix: 3072 (cond (got ; Last move was to a prefix:
2835 (allout-prefix-data (match-beginning 0) (match-end 0)) 3073 (allout-end-of-prefix))
2836 (allout-end-of-prefix))
2837 (prev ; Last move wasn't, but prev was: 3074 (prev ; Last move wasn't, but prev was:
2838 (allout-prefix-data (match-beginning 0) (match-end 0))) 3075 (goto-char prev)
3076 (allout-end-of-prefix))
2839 ((not backward) (end-of-line) nil)))) 3077 ((not backward) (end-of-line) nil))))
2840;;;_ > allout-previous-visible-heading (arg) 3078;;;_ > allout-previous-visible-heading (arg)
2841(defun allout-previous-visible-heading (arg) 3079(defun allout-previous-visible-heading (arg)
@@ -2845,7 +3083,8 @@ With argument, repeats or can move forward if negative.
2845A heading line is one that starts with a `*' (or that `allout-regexp' 3083A heading line is one that starts with a `*' (or that `allout-regexp'
2846matches)." 3084matches)."
2847 (interactive "p") 3085 (interactive "p")
2848 (allout-next-visible-heading (- arg))) 3086 (prog1 (allout-next-visible-heading (- arg))
3087 (if (interactive-p) (allout-end-of-prefix))))
2849;;;_ > allout-forward-current-level (arg) 3088;;;_ > allout-forward-current-level (arg)
2850(defun allout-forward-current-level (arg) 3089(defun allout-forward-current-level (arg)
2851 "Position point at the next heading of the same level. 3090 "Position point at the next heading of the same level.
@@ -2856,38 +3095,25 @@ Returns resulting position, else nil if none found."
2856 (interactive "p") 3095 (interactive "p")
2857 (let ((start-depth (allout-current-depth)) 3096 (let ((start-depth (allout-current-depth))
2858 (start-arg arg) 3097 (start-arg arg)
2859 (backward (> 0 arg)) 3098 (backward (> 0 arg)))
2860 last-depth
2861 (last-good (point))
2862 at-boundary)
2863 (if (= 0 start-depth) 3099 (if (= 0 start-depth)
2864 (error "No siblings, not in a topic...")) 3100 (error "No siblings, not in a topic..."))
2865 (if backward (setq arg (* -1 arg))) 3101 (if backward (setq arg (* -1 arg)))
2866 (while (not (or (zerop arg) 3102 (allout-back-to-current-heading)
2867 at-boundary)) 3103 (while (and (not (zerop arg))
2868 (while (and (not (if backward (bobp) (eobp))) 3104 (if backward
2869 (if backward (allout-previous-visible-heading 1) 3105 (allout-previous-sibling)
2870 (allout-next-visible-heading 1)) 3106 (allout-next-sibling)))
2871 (> (setq last-depth (allout-recent-depth)) start-depth))) 3107 (setq arg (1- arg)))
2872 (if (and last-depth (= last-depth start-depth) 3108 (if (not (interactive-p))
2873 (not (if backward (bobp) (eobp)))) 3109 nil
2874 (setq last-good (point) 3110 (allout-end-of-prefix)
2875 arg (1- arg)) 3111 (if (not (zerop arg))
2876 (setq at-boundary t))) 3112 (error "Hit %s level %d topic, traversed %d of %d requested"
2877 (if (and (not (eobp)) 3113 (if backward "first" "last")
2878 (= arg 0) 3114 allout-recent-depth
2879 (and (> (or last-depth (allout-depth)) 0) 3115 (- (abs start-arg) arg)
2880 (= (allout-recent-depth) start-depth))) 3116 (abs start-arg))))))
2881 allout-recent-prefix-beginning
2882 (goto-char last-good)
2883 (if (not (interactive-p))
2884 nil
2885 (allout-end-of-prefix)
2886 (error "Hit %s level %d topic, traversed %d of %d requested"
2887 (if backward "first" "last")
2888 (allout-recent-depth)
2889 (- (abs start-arg) arg)
2890 (abs start-arg))))))
2891;;;_ > allout-backward-current-level (arg) 3117;;;_ > allout-backward-current-level (arg)
2892(defun allout-backward-current-level (arg) 3118(defun allout-backward-current-level (arg)
2893 "Inverse of `allout-forward-current-level'." 3119 "Inverse of `allout-forward-current-level'."
@@ -2977,34 +3203,41 @@ this-command accordingly.
2977 3203
2978Returns the qualifying command, if any, else nil." 3204Returns the qualifying command, if any, else nil."
2979 (interactive) 3205 (interactive)
2980 (let* ((key-num (cond ((numberp last-command-char) last-command-char) 3206 (let* ((key-string (if (numberp last-command-char)
3207 (char-to-string last-command-char)))
3208 (key-num (cond ((numberp last-command-char) last-command-char)
2981 ;; for XEmacs character type: 3209 ;; for XEmacs character type:
2982 ((and (fboundp 'characterp) 3210 ((and (fboundp 'characterp)
2983 (apply 'characterp (list last-command-char))) 3211 (apply 'characterp (list last-command-char)))
2984 (apply 'char-to-int (list last-command-char))) 3212 (apply 'char-to-int (list last-command-char)))
2985 (t 0))) 3213 (t 0)))
2986 mapped-binding 3214 mapped-binding)
2987 (on-bullet (eq (point) (allout-current-bullet-pos))))
2988 3215
2989 (if (zerop key-num) 3216 (if (zerop key-num)
2990 nil 3217 nil
2991 3218
2992 (if (and (<= 33 key-num) 3219 (if (and
2993 (setq mapped-binding 3220 ;; exclude control chars and escape:
3221 (<= 33 key-num)
3222 (setq mapped-binding
3223 (or (and (assoc key-string allout-keybindings-list)
3224 ;; translate literal membership on list:
3225 (cadr (assoc key-string allout-keybindings-list)))
3226 ;; translate as a keybinding:
2994 (key-binding (concat allout-command-prefix 3227 (key-binding (concat allout-command-prefix
2995 (char-to-string 3228 (char-to-string
2996 (if (and (<= 97 key-num) ; "a" 3229 (if (and (<= 97 key-num) ; "a"
2997 (>= 122 key-num)) ; "z" 3230 (>= 122 key-num)) ; "z"
2998 (- key-num 96) key-num))) 3231 (- key-num 96) key-num)))
2999 t))) 3232 t))))
3000 ;; Qualified with the allout prefix - do hot-spot operation. 3233 ;; Qualified as an allout command - do hot-spot operation.
3001 (setq allout-post-goto-bullet t) 3234 (setq allout-post-goto-bullet t)
3002 ;; accept-defaults nil, or else we'll get allout-item-icon-key-handler. 3235 ;; accept-defaults nil, or else we'll get allout-item-icon-key-handler.
3003 (setq mapped-binding (key-binding (char-to-string key-num)))) 3236 (setq mapped-binding (key-binding (char-to-string key-num))))
3004 3237
3005 (while (keymapp mapped-binding) 3238 (while (keymapp mapped-binding)
3006 (setq mapped-binding 3239 (setq mapped-binding
3007 (lookup-key mapped-binding (read-key-sequence-vector nil t)))) 3240 (lookup-key mapped-binding (vector (read-char)))))
3008 3241
3009 (if mapped-binding 3242 (if mapped-binding
3010 (setq this-command mapped-binding))))) 3243 (setq this-command mapped-binding)))))
@@ -3036,7 +3269,7 @@ Offer one suitable for current depth DEPTH as default."
3036 (setq choice (solicit-char-in-string 3269 (setq choice (solicit-char-in-string
3037 (format "Select bullet: %s ('%s' default): " 3270 (format "Select bullet: %s ('%s' default): "
3038 sans-escapes 3271 sans-escapes
3039 default-bullet) 3272 (substring-no-properties default-bullet))
3040 sans-escapes 3273 sans-escapes
3041 t))) 3274 t)))
3042 (message "") 3275 (message "")
@@ -3275,7 +3508,7 @@ Nuances:
3275 (allout-ascend-to-depth depth)) 3508 (allout-ascend-to-depth depth))
3276 ((>= relative-depth 1) nil) 3509 ((>= relative-depth 1) nil)
3277 (t (allout-back-to-current-heading))) 3510 (t (allout-back-to-current-heading)))
3278 (setq ref-depth (allout-recent-depth)) 3511 (setq ref-depth allout-recent-depth)
3279 (setq ref-bullet 3512 (setq ref-bullet
3280 (if (> allout-recent-prefix-end 1) 3513 (if (> allout-recent-prefix-end 1)
3281 (allout-recent-bullet) 3514 (allout-recent-bullet)
@@ -3363,7 +3596,7 @@ Nuances:
3363 (setq dbl-space t)) 3596 (setq dbl-space t))
3364 (if (save-excursion 3597 (if (save-excursion
3365 (allout-next-heading) 3598 (allout-next-heading)
3366 (when (> (allout-recent-depth) ref-depth) 3599 (when (> allout-recent-depth ref-depth)
3367 ;; This is an offspring. 3600 ;; This is an offspring.
3368 (forward-line -1) 3601 (forward-line -1)
3369 (looking-at "^\\s-*$"))) 3602 (looking-at "^\\s-*$")))
@@ -3388,7 +3621,13 @@ Nuances:
3388 (if (and dbl-space (not (> relative-depth 0))) 3621 (if (and dbl-space (not (> relative-depth 0)))
3389 (newline 1)) 3622 (newline 1))
3390 (if (and (not (eobp)) 3623 (if (and (not (eobp))
3391 (not (bolp))) 3624 (or (not (bolp))
3625 (and (not (bobp))
3626 ;; bolp doesnt detect concealed
3627 ;; trailing newlines, compensate:
3628 (save-excursion
3629 (forward-char -1)
3630 (allout-hidden-p)))))
3392 (forward-char 1)))) 3631 (forward-char 1))))
3393 )) 3632 ))
3394 (setq start (point)) 3633 (setq start (point))
@@ -3507,23 +3746,28 @@ Note that refill of indented paragraphs is not done."
3507 (interactive "p") 3746 (interactive "p")
3508 (let ((initial-col (current-column)) 3747 (let ((initial-col (current-column))
3509 (on-bullet (eq (point)(allout-current-bullet-pos))) 3748 (on-bullet (eq (point)(allout-current-bullet-pos)))
3749 from to
3510 (backwards (if (< arg 0) 3750 (backwards (if (< arg 0)
3511 (setq arg (* arg -1))))) 3751 (setq arg (* arg -1)))))
3512 (while (> arg 0) 3752 (while (> arg 0)
3513 (save-excursion (allout-back-to-current-heading) 3753 (save-excursion (allout-back-to-current-heading)
3514 (allout-end-of-prefix) 3754 (allout-end-of-prefix)
3755 (setq from allout-recent-prefix-beginning
3756 to allout-recent-prefix-end)
3515 (allout-rebullet-heading t ;;; solicit 3757 (allout-rebullet-heading t ;;; solicit
3516 nil ;;; depth 3758 nil ;;; depth
3517 nil ;;; number-control 3759 nil ;;; number-control
3518 nil ;;; index 3760 nil ;;; index
3519 t)) ;;; do-successors 3761 t) ;;; do-successors
3762 (run-hook-with-args 'allout-exposure-change-hook
3763 from to t))
3520 (setq arg (1- arg)) 3764 (setq arg (1- arg))
3521 (if (<= arg 0) 3765 (if (<= arg 0)
3522 nil 3766 nil
3523 (setq initial-col nil) ; Override positioning back to init col 3767 (setq initial-col nil) ; Override positioning back to init col
3524 (if (not backwards) 3768 (if (not backwards)
3525 (allout-next-visible-heading 1) 3769 (allout-next-visible-heading 1)
3526 (allout-goto-prefix) 3770 (allout-goto-prefix-doublechecked)
3527 (allout-next-visible-heading -1)))) 3771 (allout-next-visible-heading -1))))
3528 (message "Done.") 3772 (message "Done.")
3529 (cond (on-bullet (goto-char (allout-current-bullet-pos))) 3773 (cond (on-bullet (goto-char (allout-current-bullet-pos)))
@@ -3573,7 +3817,7 @@ this function."
3573 (new-depth (or new-depth current-depth)) 3817 (new-depth (or new-depth current-depth))
3574 (mb allout-recent-prefix-beginning) 3818 (mb allout-recent-prefix-beginning)
3575 (me allout-recent-prefix-end) 3819 (me allout-recent-prefix-end)
3576 (current-bullet (buffer-substring (- me 1) me)) 3820 (current-bullet (buffer-substring-no-properties (- me 1) me))
3577 (new-prefix (allout-make-topic-prefix current-bullet 3821 (new-prefix (allout-make-topic-prefix current-bullet
3578 nil 3822 nil
3579 new-depth 3823 new-depth
@@ -3627,11 +3871,17 @@ this function."
3627 ) ; let* ((current-depth (allout-depth))...) 3871 ) ; let* ((current-depth (allout-depth))...)
3628 ) ; defun 3872 ) ; defun
3629;;;_ > allout-rebullet-topic (arg) 3873;;;_ > allout-rebullet-topic (arg)
3630(defun allout-rebullet-topic (arg) 3874(defun allout-rebullet-topic (arg &optional sans-offspring)
3631 "Rebullet the visible topic containing point and all contained subtopics. 3875 "Rebullet the visible topic containing point and all contained subtopics.
3632 3876
3633Descends into invisible as well as visible topics, however. 3877Descends into invisible as well as visible topics, however.
3634 3878
3879When optional sans-offspring is non-nil, subtopics are not
3880shifted. \(Shifting a topic outwards without shifting its
3881offspring is disallowed, since this would create a \"containment
3882discontinuity\", where the depth difference between a topic and
3883its immediate offspring is greater than one.)
3884
3635With repeat count, shift topic depth by that amount." 3885With repeat count, shift topic depth by that amount."
3636 (interactive "P") 3886 (interactive "P")
3637 (let ((start-col (current-column))) 3887 (let ((start-col (current-column)))
@@ -3642,17 +3892,18 @@ With repeat count, shift topic depth by that amount."
3642 ;; Fill the user in, in case we're shifting a big topic: 3892 ;; Fill the user in, in case we're shifting a big topic:
3643 (if (not (zerop arg)) (message "Shifting...")) 3893 (if (not (zerop arg)) (message "Shifting..."))
3644 (allout-back-to-current-heading) 3894 (allout-back-to-current-heading)
3645 (if (<= (+ (allout-recent-depth) arg) 0) 3895 (if (<= (+ allout-recent-depth arg) 0)
3646 (error "Attempt to shift topic below level 1")) 3896 (error "Attempt to shift topic below level 1"))
3647 (allout-rebullet-topic-grunt arg) 3897 (allout-rebullet-topic-grunt arg nil nil nil nil sans-offspring)
3648 (if (not (zerop arg)) (message "Shifting... done."))) 3898 (if (not (zerop arg)) (message "Shifting... done.")))
3649 (move-to-column (max 0 (+ start-col arg))))) 3899 (move-to-column (max 0 (+ start-col arg)))))
3650;;;_ > allout-rebullet-topic-grunt (&optional relative-depth ...) 3900;;;_ > allout-rebullet-topic-grunt (&optional relative-depth ...)
3651(defun allout-rebullet-topic-grunt (&optional relative-depth 3901(defun allout-rebullet-topic-grunt (&optional relative-depth
3652 starting-depth 3902 starting-depth
3653 starting-point 3903 starting-point
3654 index 3904 index
3655 do-successors) 3905 do-successors
3906 sans-offspring)
3656 "Like `allout-rebullet-topic', but on nearest containing topic 3907 "Like `allout-rebullet-topic', but on nearest containing topic
3657\(visible or not). 3908\(visible or not).
3658 3909
@@ -3663,8 +3914,23 @@ All arguments are optional.
3663First arg RELATIVE-DEPTH means to shift the depth of the entire 3914First arg RELATIVE-DEPTH means to shift the depth of the entire
3664topic that amount. 3915topic that amount.
3665 3916
3666The rest of the args are for internal recursive use by the function 3917Several subsequent args are for internal recursive use by the function
3667itself. The are STARTING-DEPTH, STARTING-POINT, and INDEX." 3918itself: STARTING-DEPTH, STARTING-POINT, and INDEX.
3919
3920Finally, if optional SANS-OFFSPRING is non-nil then the offspring
3921are not shifted. \(Shifting a topic outwards without shifting
3922its offspring is disallowed, since this would create a
3923\"containment discontinuity\", where the depth difference between
3924a topic and its immediate offspring is greater than one..)"
3925
3926 ;; XXX the recursion here is peculiar, and in general the routine may
3927 ;; need simplification with refactoring.
3928
3929 (if (and sans-offspring
3930 relative-depth
3931 (< relative-depth 0))
3932 (error (concat "Attempt to shift topic outwards without offspring,"
3933 " would cause containment discontinuity.")))
3668 3934
3669 (let* ((relative-depth (or relative-depth 0)) 3935 (let* ((relative-depth (or relative-depth 0))
3670 (new-depth (allout-depth)) 3936 (new-depth (allout-depth))
@@ -3676,44 +3942,57 @@ itself. The are STARTING-DEPTH, STARTING-POINT, and INDEX."
3676 (and (or (zerop relative-depth) 3942 (and (or (zerop relative-depth)
3677 (not on-starting-call)) 3943 (not on-starting-call))
3678 (allout-sibling-index)))) 3944 (allout-sibling-index))))
3945 (starting-index index)
3679 (moving-outwards (< 0 relative-depth)) 3946 (moving-outwards (< 0 relative-depth))
3680 (starting-point (or starting-point (point)))) 3947 (starting-point (or starting-point (point)))
3948 (local-point (point)))
3681 3949
3682 ;; Sanity check for excessive promotion done only on starting call: 3950 ;; Sanity check for excessive promotion done only on starting call:
3683 (and on-starting-call 3951 (and on-starting-call
3684 moving-outwards 3952 moving-outwards
3685 (> 0 (+ starting-depth relative-depth)) 3953 (> 0 (+ starting-depth relative-depth))
3686 (error "Attempt to shift topic out beyond level 1")) ;;; ====> 3954 (error "Attempt to shift topic out beyond level 1"))
3687 3955
3688 (cond ((= starting-depth new-depth) 3956 (cond ((= starting-depth new-depth)
3689 ;; We're at depth to work on this one: 3957 ;; We're at depth to work on this one.
3690 (allout-rebullet-heading nil ;;; solicit 3958
3691 (+ starting-depth ;;; starting-depth 3959 ;; When shifting out we work on the children before working on
3692 relative-depth) 3960 ;; the parent to avoid interim `allout-aberrant-container-p'
3693 nil ;;; number 3961 ;; aberrancy, and vice-versa when shifting in:
3694 index ;;; index 3962 (if (>= relative-depth 0)
3695 ;; Every contained topic will get hit, 3963 (allout-rebullet-heading nil
3696 ;; and we have to get to outside ones 3964 (+ starting-depth relative-depth)
3697 ;; deliberately: 3965 nil ;;; number
3698 nil) ;;; do-successors 3966 index
3699 ;; ... and work on subsequent ones which are at greater depth: 3967 nil)) ;;; do-successors
3700 (setq index 0) 3968 (when (not sans-offspring)
3701 (allout-next-heading) 3969 ;; ... and work on subsequent ones which are at greater depth:
3702 (while (and (not (eobp)) 3970 (setq index 0)
3703 (< starting-depth (allout-recent-depth))) 3971 (allout-next-heading)
3704 (setq index (1+ index)) 3972 (while (and (not (eobp))
3705 (allout-rebullet-topic-grunt relative-depth ;;; relative-depth 3973 (< starting-depth (allout-depth)))
3706 (1+ starting-depth);;;starting-depth 3974 (setq index (1+ index))
3707 starting-point ;;; starting-point 3975 (allout-rebullet-topic-grunt relative-depth
3708 index))) ;;; index 3976 (1+ starting-depth)
3977 starting-point
3978 index)))
3979 (when (< relative-depth 0)
3980 (save-excursion
3981 (goto-char local-point)
3982 (allout-rebullet-heading nil ;;; solicit
3983 (+ starting-depth relative-depth)
3984 nil ;;; number
3985 starting-index
3986 nil)))) ;;; do-successors
3709 3987
3710 ((< starting-depth new-depth) 3988 ((< starting-depth new-depth)
3711 ;; Rare case - subtopic more than one level deeper than parent. 3989 ;; Rare case - subtopic more than one level deeper than parent.
3712 ;; Treat this one at an even deeper level: 3990 ;; Treat this one at an even deeper level:
3713 (allout-rebullet-topic-grunt relative-depth ;;; relative-depth 3991 (allout-rebullet-topic-grunt relative-depth
3714 new-depth ;;; starting-depth 3992 new-depth
3715 starting-point ;;; starting-point 3993 starting-point
3716 index))) ;;; index 3994 index
3995 sans-offspring)))
3717 3996
3718 (if on-starting-call 3997 (if on-starting-call
3719 (progn 3998 (progn
@@ -3721,8 +4000,8 @@ itself. The are STARTING-DEPTH, STARTING-POINT, and INDEX."
3721 ;; if topic has changed depth 4000 ;; if topic has changed depth
3722 (if (or do-successors 4001 (if (or do-successors
3723 (and (not (zerop relative-depth)) 4002 (and (not (zerop relative-depth))
3724 (or (= (allout-recent-depth) starting-depth) 4003 (or (= allout-recent-depth starting-depth)
3725 (= (allout-recent-depth) (+ starting-depth 4004 (= allout-recent-depth (+ starting-depth
3726 relative-depth))))) 4005 relative-depth)))))
3727 (allout-rebullet-heading nil nil nil nil t)) 4006 (allout-rebullet-heading nil nil nil nil t))
3728 ;; Now rectify numbering of new siblings of the adjusted topic, 4007 ;; Now rectify numbering of new siblings of the adjusted topic,
@@ -3747,24 +4026,24 @@ Returns final depth."
3747 was-eobp) 4026 was-eobp)
3748 (while (and (not (eobp)) 4027 (while (and (not (eobp))
3749 (allout-depth) 4028 (allout-depth)
3750 (>= (allout-recent-depth) depth) 4029 (>= allout-recent-depth depth)
3751 (>= ascender depth)) 4030 (>= ascender depth))
3752 ; Skip over all topics at 4031 ; Skip over all topics at
3753 ; lesser depths, which can not 4032 ; lesser depths, which can not
3754 ; have been disturbed: 4033 ; have been disturbed:
3755 (while (and (not (setq was-eobp (eobp))) 4034 (while (and (not (setq was-eobp (eobp)))
3756 (> (allout-recent-depth) ascender)) 4035 (> allout-recent-depth ascender))
3757 (allout-next-heading)) 4036 (allout-next-heading))
3758 ; Prime ascender for ascension: 4037 ; Prime ascender for ascension:
3759 (setq ascender (1- (allout-recent-depth))) 4038 (setq ascender (1- allout-recent-depth))
3760 (if (>= (allout-recent-depth) depth) 4039 (if (>= allout-recent-depth depth)
3761 (allout-rebullet-heading nil ;;; solicit 4040 (allout-rebullet-heading nil ;;; solicit
3762 nil ;;; depth 4041 nil ;;; depth
3763 nil ;;; number-control 4042 nil ;;; number-control
3764 nil ;;; index 4043 nil ;;; index
3765 t)) ;;; do-successors 4044 t)) ;;; do-successors
3766 (if was-eobp (goto-char (point-max))))) 4045 (if was-eobp (goto-char (point-max)))))
3767 (allout-recent-depth)) 4046 allout-recent-depth)
3768;;;_ > allout-number-siblings (&optional denumber) 4047;;;_ > allout-number-siblings (&optional denumber)
3769(defun allout-number-siblings (&optional denumber) 4048(defun allout-number-siblings (&optional denumber)
3770 "Assign numbered topic prefix to this topic and its siblings. 4049 "Assign numbered topic prefix to this topic and its siblings.
@@ -3780,7 +4059,7 @@ rebulleting each topic at this level."
3780 (save-excursion 4059 (save-excursion
3781 (allout-back-to-current-heading) 4060 (allout-back-to-current-heading)
3782 (allout-beginning-of-level) 4061 (allout-beginning-of-level)
3783 (let ((depth (allout-recent-depth)) 4062 (let ((depth allout-recent-depth)
3784 (index (if (not denumber) 1)) 4063 (index (if (not denumber) 1))
3785 (use-bullet (equal '(16) denumber)) 4064 (use-bullet (equal '(16) denumber))
3786 (more t)) 4065 (more t))
@@ -3794,55 +4073,84 @@ rebulleting each topic at this level."
3794 (setq more (allout-next-sibling depth nil)))))) 4073 (setq more (allout-next-sibling depth nil))))))
3795;;;_ > allout-shift-in (arg) 4074;;;_ > allout-shift-in (arg)
3796(defun allout-shift-in (arg) 4075(defun allout-shift-in (arg)
3797 "Increase depth of current heading and any topics collapsed within it. 4076 "Increase depth of current heading and any items collapsed within it.
4077
4078With a negative argument, the item is shifted out using
4079`allout-shift-out', instead.
4080
4081With an argument greater than one, shift-in the item but not its
4082offspring, making the item into a sibling of its former children,
4083and a child of sibling that formerly preceeded it.
4084
4085You are not allowed to shift the first offspring of a topic
4086inwards, because that would yield a \"containment
4087discontinuity\", where the depth difference between a topic and
4088its immediate offspring is greater than one. The first topic in
4089the file can be adjusted to any positive depth, however."
3798 4090
3799We disallow shifts that would result in the topic having a depth more than
3800one level greater than the immediately previous topic, to avoid containment
3801discontinuity. The first topic in the file can be adjusted to any positive
3802depth, however."
3803 (interactive "p") 4091 (interactive "p")
3804 (if (> arg 0) 4092 (if (< arg 0)
3805 ;; refuse to create a containment discontinuity: 4093 (allout-shift-out (* arg -1))
3806 (save-excursion 4094 ;; refuse to create a containment discontinuity:
3807 (allout-back-to-current-heading) 4095 (save-excursion
3808 (if (not (bobp)) 4096 (allout-back-to-current-heading)
3809 (let* ((current-depth (allout-recent-depth)) 4097 (if (not (bobp))
3810 (start-point (point)) 4098 (let* ((current-depth allout-recent-depth)
3811 (predecessor-depth (progn 4099 (start-point (point))
3812 (forward-char -1) 4100 (predecessor-depth (progn
3813 (allout-goto-prefix) 4101 (forward-char -1)
3814 (if (< (point) start-point) 4102 (allout-goto-prefix-doublechecked)
3815 (allout-recent-depth) 4103 (if (< (point) start-point)
3816 0)))) 4104 allout-recent-depth
3817 (if (and (> predecessor-depth 0) 4105 0))))
3818 (> (+ current-depth arg) 4106 (if (and (> predecessor-depth 0)
3819 (1+ predecessor-depth))) 4107 (> (1+ current-depth)
3820 (error (concat "Disallowed shift deeper than" 4108 (1+ predecessor-depth)))
3821 " containing topic's children."))))))) 4109 (error (concat "Disallowed shift deeper than"
3822 (let ((where (point)) 4110 " containing topic's children."))))))
3823 has-successor) 4111 (let ((where (point)))
3824 (if (and (< arg 0) 4112 (allout-rebullet-topic 1 (and (> arg 1) 'sans-offspring))
3825 (allout-current-topic-collapsed-p) 4113 (run-hook-with-args 'allout-structure-shifted-hook arg where))))
3826 (save-excursion (allout-next-sibling)))
3827 (setq has-successor t))
3828 (allout-rebullet-topic arg)
3829 (when (< arg 0)
3830 (save-excursion
3831 (if (allout-ascend)
3832 (allout-show-children)))
3833 (if has-successor
3834 (allout-show-children)))
3835 (run-hook-with-args 'allout-structure-shifted-hook arg where)))
3836;;;_ > allout-shift-out (arg) 4114;;;_ > allout-shift-out (arg)
3837(defun allout-shift-out (arg) 4115(defun allout-shift-out (arg)
3838 "Decrease depth of current heading and any topics collapsed within it. 4116 "Decrease depth of current heading and any topics collapsed within it.
4117This will make the item a sibling of its former container.
4118
4119With a negative argument, the item is shifted in using
4120`allout-shift-in', instead.
4121
4122With an argument greater than one, shift-out the item's offspring
4123but not the item itself, making the former children siblings of
4124the item.
3839 4125
3840We disallow shifts that would result in the topic having a depth more than 4126With an argument greater than 1, the item's offspring are shifted
3841one level greater than the immediately previous topic, to avoid containment 4127out without shifting the item. This will make the immediate
3842discontinuity. The first topic in the file can be adjusted to any positive 4128subtopics into siblings of the item."
3843depth, however."
3844 (interactive "p") 4129 (interactive "p")
3845 (allout-shift-in (* arg -1))) 4130 (if (< arg 0)
4131 (allout-shift-in (* arg -1))
4132 ;; Get proper exposure in this area:
4133 (save-excursion (if (allout-ascend)
4134 (allout-show-children)))
4135 ;; Show collapsed children if there's a successor which will become
4136 ;; their sibling:
4137 (if (and (allout-current-topic-collapsed-p)
4138 (save-excursion (allout-next-sibling)))
4139 (allout-show-children))
4140 (let ((where (and (allout-depth) allout-recent-prefix-beginning)))
4141 (save-excursion
4142 (if (> arg 1)
4143 ;; Shift the offspring but not the topic:
4144 (let ((children-chart (allout-chart-subtree 1)))
4145 (if (listp (car children-chart))
4146 ;; whoops:
4147 (setq children-chart (allout-flatten children-chart)))
4148 (save-excursion
4149 (dolist (child-point children-chart)
4150 (goto-char child-point)
4151 (allout-shift-out 1))))
4152 (allout-rebullet-topic (* arg -1))))
4153 (run-hook-with-args 'allout-structure-shifted-hook (* arg -1) where))))
3846;;;_ : Surgery (kill-ring) functions with special provisions for outlines: 4154;;;_ : Surgery (kill-ring) functions with special provisions for outlines:
3847;;;_ > allout-kill-line (&optional arg) 4155;;;_ > allout-kill-line (&optional arg)
3848(defun allout-kill-line (&optional arg) 4156(defun allout-kill-line (&optional arg)
@@ -3857,21 +4165,18 @@ depth, however."
3857 (kill-line arg) 4165 (kill-line arg)
3858 ;; Ah, have to watch out for adjustments: 4166 ;; Ah, have to watch out for adjustments:
3859 (let* ((beg (point)) 4167 (let* ((beg (point))
4168 end
3860 (beg-hidden (allout-hidden-p)) 4169 (beg-hidden (allout-hidden-p))
3861 (end-hidden (save-excursion (allout-end-of-current-line) 4170 (end-hidden (save-excursion (allout-end-of-current-line)
4171 (setq end (point))
3862 (allout-hidden-p))) 4172 (allout-hidden-p)))
3863 (depth (allout-depth)) 4173 (depth (allout-depth)))
3864 (collapsed (allout-current-topic-collapsed-p)))
3865 4174
3866 (if collapsed 4175 (allout-annotate-hidden beg end)
3867 (put-text-property beg (1+ beg) 'allout-was-collapsed t)
3868 (remove-text-properties beg (1+ beg) '(allout-was-collapsed t)))
3869 4176
3870 (if (and (not beg-hidden) (not end-hidden)) 4177 (if (and (not beg-hidden) (not end-hidden))
3871 (allout-unprotected (kill-line arg)) 4178 (allout-unprotected (kill-line arg))
3872 (kill-line arg)) 4179 (kill-line arg))
3873 ; Provide some feedback:
3874 (sit-for 0)
3875 (if allout-numbered-bullet 4180 (if allout-numbered-bullet
3876 (save-excursion ; Renumber subsequent topics if needed: 4181 (save-excursion ; Renumber subsequent topics if needed:
3877 (if (not (looking-at allout-regexp)) 4182 (if (not (looking-at allout-regexp))
@@ -3889,20 +4194,13 @@ Trailing whitespace is killed with a topic if that whitespace:
3889 - would not be added to whitespace already separating the topic from the 4194 - would not be added to whitespace already separating the topic from the
3890 previous one. 4195 previous one.
3891 4196
3892Completely collapsed topics are marked as such, for re-collapse 4197Topic exposure is marked with text-properties, to be used by
3893when yank with allout-yank into an outline as a heading." 4198allout-yank-processing for exposure recovery."
3894
3895 ;; Some finagling is done to make complex topic kills appear faster
3896 ;; than they actually are. A redisplay is performed immediately
3897 ;; after the region is deleted, though the renumbering process
3898 ;; has yet to be performed. This means that there may appear to be
3899 ;; a lag *after* a kill has been performed.
3900 4199
3901 (interactive) 4200 (interactive)
3902 (let* ((inhibit-field-text-motion t) 4201 (let* ((inhibit-field-text-motion t)
3903 (collapsed (allout-current-topic-collapsed-p))
3904 (beg (prog1 (allout-back-to-current-heading) (beginning-of-line))) 4202 (beg (prog1 (allout-back-to-current-heading) (beginning-of-line)))
3905 (depth (allout-recent-depth))) 4203 (depth allout-recent-depth))
3906 (allout-end-of-current-subtree) 4204 (allout-end-of-current-subtree)
3907 (if (and (/= (current-column) 0) (not (eobp))) 4205 (if (and (/= (current-column) 0) (not (eobp)))
3908 (forward-char 1)) 4206 (forward-char 1))
@@ -3910,21 +4208,88 @@ when yank with allout-yank into an outline as a heading."
3910 (if (and (looking-at "\n") 4208 (if (and (looking-at "\n")
3911 (or (save-excursion 4209 (or (save-excursion
3912 (or (not (allout-next-heading)) 4210 (or (not (allout-next-heading))
3913 (= depth (allout-recent-depth)))) 4211 (= depth allout-recent-depth)))
3914 (and (> (- beg (point-min)) 3) 4212 (and (> (- beg (point-min)) 3)
3915 (string= (buffer-substring (- beg 2) beg) "\n\n")))) 4213 (string= (buffer-substring (- beg 2) beg) "\n\n"))))
3916 (forward-char 1))) 4214 (forward-char 1)))
3917 4215
3918 (if collapsed 4216 (allout-annotate-hidden beg (point))
3919 (allout-unprotected 4217
3920 (put-text-property beg (1+ beg) 'allout-was-collapsed t))
3921 (allout-unprotected
3922 (remove-text-properties beg (1+ beg) '(allout-was-collapsed t))))
3923 (allout-unprotected (kill-region beg (point))) 4218 (allout-unprotected (kill-region beg (point)))
3924 (sit-for 0)
3925 (save-excursion 4219 (save-excursion
3926 (allout-renumber-to-depth depth)) 4220 (allout-renumber-to-depth depth))
3927 (run-hook-with-args 'allout-structure-deleted-hook depth (point)))) 4221 (run-hook-with-args 'allout-structure-deleted-hook depth (point))))
4222;;;_ > allout-annotate-hidden (begin end)
4223(defun allout-annotate-hidden (begin end)
4224 "Qualify text with properties to indicate exposure status."
4225
4226 (let ((was-modified (buffer-modified-p)))
4227 (allout-unprotected
4228 (remove-text-properties begin end '(allout-was-hidden t)))
4229 (save-excursion
4230 (goto-char begin)
4231 (let (done next prev overlay)
4232 (while (not done)
4233 ;; at or advance to start of next hidden region:
4234 (if (not (allout-hidden-p))
4235 (setq next
4236 (next-single-char-property-change (point)
4237 'invisible nil end)))
4238 (if (or (not next) (eq prev next))
4239 ;; still not at start of hidden area - must not be any left.
4240 (setq done t)
4241 (goto-char next)
4242 (setq prev next)
4243 (if (not (allout-hidden-p))
4244 ;; still not at start of hidden area.
4245 (setq done t)
4246 (setq overlay (allout-get-invisibility-overlay))
4247 (setq next (overlay-end overlay)
4248 prev next)
4249 ;; advance to end of this hidden area:
4250 (when next
4251 (goto-char next)
4252 (allout-unprotected
4253 (put-text-property (overlay-start overlay) next
4254 'allout-was-hidden t))))))))
4255 (set-buffer-modified-p was-modified)))
4256;;;_ > allout-hide-by-annotation (begin end)
4257(defun allout-hide-by-annotation (begin end)
4258 "Translate text properties indicating exposure status into actual exposure."
4259 (save-excursion
4260 (goto-char begin)
4261 (let ((was-modified (buffer-modified-p))
4262 done next prev)
4263 (while (not done)
4264 ;; at or advance to start of next annotation:
4265 (if (not (get-text-property (point) 'allout-was-hidden))
4266 (setq next (next-single-char-property-change (point)
4267 'allout-was-hidden
4268 nil end)))
4269 (if (or (not next) (eq prev next))
4270 ;; no more or not advancing - must not be any left.
4271 (setq done t)
4272 (goto-char next)
4273 (setq prev next)
4274 (if (not (get-text-property (point) 'allout-was-hidden))
4275 ;; still not at start of annotation.
4276 (setq done t)
4277 ;; advance to just after end of this annotation:
4278 (setq next (next-single-char-property-change (point)
4279 'allout-was-hidden
4280 nil end))
4281 (overlay-put (make-overlay prev next)
4282 'category 'allout-exposure-category)
4283 (allout-unprotected
4284 (remove-text-properties prev next '(allout-was-hidden t)))
4285 (setq prev next)
4286 (if next (goto-char next)))))
4287 (set-buffer-modified-p was-modified))))
4288;;;_ > allout-remove-exposure-annotation (begin end)
4289(defun allout-remove-exposure-annotation (begin end)
4290 "Remove text properties indicating exposure status."
4291 (remove-text-properties begin end '(allout-was-hidden t)))
4292
3928;;;_ > allout-yank-processing () 4293;;;_ > allout-yank-processing ()
3929(defun allout-yank-processing (&optional arg) 4294(defun allout-yank-processing (&optional arg)
3930 4295
@@ -3955,12 +4320,10 @@ however, are left exactly like normal, non-allout-specific yanks."
3955 (let* ((subj-beg (point)) 4320 (let* ((subj-beg (point))
3956 (into-bol (bolp)) 4321 (into-bol (bolp))
3957 (subj-end (allout-mark-marker t)) 4322 (subj-end (allout-mark-marker t))
3958 (was-collapsed (get-text-property subj-beg 'allout-was-collapsed))
3959 ;; 'resituate' if yanking an entire topic into topic header: 4323 ;; 'resituate' if yanking an entire topic into topic header:
3960 (resituate (and (allout-e-o-prefix-p) 4324 (resituate (and (allout-e-o-prefix-p)
3961 (looking-at (concat "\\(" allout-regexp "\\)")) 4325 (looking-at allout-regexp)
3962 (allout-prefix-data (match-beginning 1) 4326 (allout-prefix-data)))
3963 (match-end 1))))
3964 ;; `rectify-numbering' if resituating (where several topics may 4327 ;; `rectify-numbering' if resituating (where several topics may
3965 ;; be resituating) or yanking a topic into a topic slot (bol): 4328 ;; be resituating) or yanking a topic into a topic slot (bol):
3966 (rectify-numbering (or resituate 4329 (rectify-numbering (or resituate
@@ -3968,7 +4331,7 @@ however, are left exactly like normal, non-allout-specific yanks."
3968 (if resituate 4331 (if resituate
3969 ; The yanked stuff is a topic: 4332 ; The yanked stuff is a topic:
3970 (let* ((prefix-len (- (match-end 1) subj-beg)) 4333 (let* ((prefix-len (- (match-end 1) subj-beg))
3971 (subj-depth (allout-recent-depth)) 4334 (subj-depth allout-recent-depth)
3972 (prefix-bullet (allout-recent-bullet)) 4335 (prefix-bullet (allout-recent-bullet))
3973 (adjust-to-depth 4336 (adjust-to-depth
3974 ;; Nil if adjustment unnecessary, otherwise depth to which 4337 ;; Nil if adjustment unnecessary, otherwise depth to which
@@ -3982,15 +4345,13 @@ however, are left exactly like normal, non-allout-specific yanks."
3982 (beginning-of-line) 4345 (beginning-of-line)
3983 (not (= (point) subj-beg))) 4346 (not (= (point) subj-beg)))
3984 (looking-at allout-regexp) 4347 (looking-at allout-regexp)
3985 (allout-prefix-data (match-beginning 0) 4348 (allout-prefix-data))
3986 (match-end 0))) 4349 allout-recent-depth)))
3987 (allout-recent-depth))))
3988 (more t)) 4350 (more t))
3989 (setq rectify-numbering allout-numbered-bullet) 4351 (setq rectify-numbering allout-numbered-bullet)
3990 (if adjust-to-depth 4352 (if adjust-to-depth
3991 ; Do the adjustment: 4353 ; Do the adjustment:
3992 (progn 4354 (progn
3993 (message "... yanking") (sit-for 0)
3994 (save-restriction 4355 (save-restriction
3995 (narrow-to-region subj-beg subj-end) 4356 (narrow-to-region subj-beg subj-end)
3996 ; Trim off excessive blank 4357 ; Trim off excessive blank
@@ -4006,7 +4367,7 @@ however, are left exactly like normal, non-allout-specific yanks."
4006 (while more 4367 (while more
4007 (allout-back-to-current-heading) 4368 (allout-back-to-current-heading)
4008 ; go as high as we can in each bunch: 4369 ; go as high as we can in each bunch:
4009 (while (allout-ascend-to-depth (1- (allout-depth)))) 4370 (while (allout-ascend))
4010 (save-excursion 4371 (save-excursion
4011 (allout-rebullet-topic-grunt (- adjust-to-depth 4372 (allout-rebullet-topic-grunt (- adjust-to-depth
4012 subj-depth)) 4373 subj-depth))
@@ -4015,7 +4376,6 @@ however, are left exactly like normal, non-allout-specific yanks."
4015 (progn (widen) 4376 (progn (widen)
4016 (forward-char -1) 4377 (forward-char -1)
4017 (narrow-to-region subj-beg (point)))))) 4378 (narrow-to-region subj-beg (point))))))
4018 (message "")
4019 ;; Preserve new bullet if it's a distinctive one, otherwise 4379 ;; Preserve new bullet if it's a distinctive one, otherwise
4020 ;; use old one: 4380 ;; use old one:
4021 (if (string-match (regexp-quote prefix-bullet) 4381 (if (string-match (regexp-quote prefix-bullet)
@@ -4042,19 +4402,19 @@ however, are left exactly like normal, non-allout-specific yanks."
4042 (progn 4402 (progn
4043 (save-excursion 4403 (save-excursion
4044 ; Give some preliminary feedback: 4404 ; Give some preliminary feedback:
4045 (message "... reconciling numbers") (sit-for 0) 4405 (message "... reconciling numbers")
4046 ; ... and renumber, in case necessary: 4406 ; ... and renumber, in case necessary:
4047 (goto-char subj-beg) 4407 (goto-char subj-beg)
4048 (if (allout-goto-prefix) 4408 (if (allout-goto-prefix-doublechecked)
4049 (allout-rebullet-heading nil ;;; solicit 4409 (allout-rebullet-heading nil ;;; solicit
4050 (allout-depth) ;;; depth 4410 (allout-depth) ;;; depth
4051 nil ;;; number-control 4411 nil ;;; number-control
4052 nil ;;; index 4412 nil ;;; index
4053 t)) 4413 t))
4054 (message "")))) 4414 (message ""))))
4055 (when (and (or into-bol resituate) was-collapsed) 4415 (if (or into-bol resituate)
4056 (remove-text-properties subj-beg (1+ subj-beg) '(allout-was-collapsed)) 4416 (allout-hide-by-annotation (point) (allout-mark-marker t))
4057 (allout-hide-current-subtree)) 4417 (allout-remove-exposure-annotation (allout-mark-marker t) (point)))
4058 (if (not resituate) 4418 (if (not resituate)
4059 (exchange-point-and-mark)) 4419 (exchange-point-and-mark))
4060 (run-hook-with-args 'allout-structure-added-hook subj-beg subj-end)))) 4420 (run-hook-with-args 'allout-structure-added-hook subj-beg subj-end))))
@@ -4139,7 +4499,7 @@ by pops to non-distinctive yanks. Bug..."
4139 (error "%s not found and can't be created" file-name))) 4499 (error "%s not found and can't be created" file-name)))
4140 (condition-case failure 4500 (condition-case failure
4141 (find-file-other-window file-name) 4501 (find-file-other-window file-name)
4142 ('error failure)) 4502 (error failure))
4143 (error "%s not found" file-name)) 4503 (error "%s not found" file-name))
4144 ) 4504 )
4145 ) 4505 )
@@ -4198,7 +4558,7 @@ the exposure."
4198 (interactive) 4558 (interactive)
4199 (save-excursion 4559 (save-excursion
4200 (let (beg end) 4560 (let (beg end)
4201 (allout-goto-prefix) 4561 (allout-goto-prefix-doublechecked)
4202 (setq beg (if (allout-hidden-p) (1- (point)) (point))) 4562 (setq beg (if (allout-hidden-p) (1- (point)) (point)))
4203 (setq end (allout-pre-next-prefix)) 4563 (setq end (allout-pre-next-prefix))
4204 (allout-flag-region beg end nil) 4564 (allout-flag-region beg end nil)
@@ -4235,8 +4595,27 @@ point of non-opened subtree?)"
4235 (save-excursion 4595 (save-excursion
4236 (allout-beginning-of-current-line) 4596 (allout-beginning-of-current-line)
4237 (save-restriction 4597 (save-restriction
4238 (let* ((chart (allout-chart-subtree (or level 1))) 4598 (let* (depth
4239 (to-reveal (allout-chart-to-reveal chart (or level 1)))) 4599 (chart (allout-chart-subtree (or level 1)))
4600 (to-reveal (or (allout-chart-to-reveal chart (or level 1))
4601 ;; interactive, show discontinuous children:
4602 (and chart
4603 (interactive-p)
4604 (save-excursion
4605 (allout-back-to-current-heading)
4606 (setq depth (allout-current-depth))
4607 (and (allout-next-heading)
4608 (> allout-recent-depth
4609 (1+ depth))))
4610 (message
4611 "Discontinuous offspring; use `%s %s'%s."
4612 (substitute-command-keys
4613 "\\[universal-argument]")
4614 (substitute-command-keys
4615 "\\[allout-shift-out]")
4616 " to elevate them.")
4617 (allout-chart-to-reveal
4618 chart (- allout-recent-depth depth))))))
4240 (goto-char start-point) 4619 (goto-char start-point)
4241 (when (and strict (allout-hidden-p)) 4620 (when (and strict (allout-hidden-p))
4242 ;; Concealed root would already have been taken care of, 4621 ;; Concealed root would already have been taken care of,
@@ -4267,14 +4646,12 @@ Useful for coherently exposing to a random point in a hidden region."
4267 (save-excursion 4646 (save-excursion
4268 (let ((inhibit-field-text-motion t) 4647 (let ((inhibit-field-text-motion t)
4269 (orig-pt (point)) 4648 (orig-pt (point))
4270 (orig-pref (allout-goto-prefix)) 4649 (orig-pref (allout-goto-prefix-doublechecked))
4271 (last-at (point)) 4650 (last-at (point))
4272 bag-it) 4651 bag-it)
4273 (while (or bag-it (allout-hidden-p)) 4652 (while (or bag-it (allout-hidden-p))
4274 (while (allout-hidden-p) 4653 (while (allout-hidden-p)
4275 ;; XXX We would use `(move-beginning-of-line 1)', but it gets 4654 (move-beginning-of-line 1)
4276 ;; stuck on hidden newlines at column 80, as of GNU Emacs 22.0.50.
4277 (beginning-of-line)
4278 (if (allout-hidden-p) (forward-char -1))) 4655 (if (allout-hidden-p) (forward-char -1)))
4279 (if (= last-at (setq last-at (point))) 4656 (if (= last-at (setq last-at (point)))
4280 ;; Oops, we're not making any progress! Show the current 4657 ;; Oops, we're not making any progress! Show the current
@@ -4286,9 +4663,9 @@ Useful for coherently exposing to a random point in a hidden region."
4286 (beep) 4663 (beep)
4287 (message "%s: %s" 4664 (message "%s: %s"
4288 "allout-show-to-offshoot: " 4665 "allout-show-to-offshoot: "
4289 "Aberrant nesting encountered."))) 4666 "Aberrant nesting encountered."))
4290 (allout-show-children) 4667 (allout-show-children)
4291 (goto-char orig-pref)) 4668 (goto-char orig-pref)))
4292 (goto-char orig-pt))) 4669 (goto-char orig-pt)))
4293 (if (allout-hidden-p) 4670 (if (allout-hidden-p)
4294 (allout-show-entry))) 4671 (allout-show-entry)))
@@ -4368,10 +4745,10 @@ siblings, even if the target topic is already closed."
4368 (current-exposed (not (allout-current-topic-collapsed-p t)))) 4745 (current-exposed (not (allout-current-topic-collapsed-p t))))
4369 (cond (current-exposed (allout-flag-current-subtree t)) 4746 (cond (current-exposed (allout-flag-current-subtree t))
4370 (just-close nil) 4747 (just-close nil)
4371 ((allout-up-current-level 1 t) (allout-hide-current-subtree)) 4748 ((allout-ascend) (allout-hide-current-subtree))
4372 (t (goto-char 0) 4749 (t (goto-char 0)
4373 (message sibs-msg) 4750 (message sibs-msg)
4374 (allout-goto-prefix) 4751 (allout-goto-prefix-doublechecked)
4375 (allout-expose-topic '(0 :)) 4752 (allout-expose-topic '(0 :))
4376 (message (concat sibs-msg " Done.")))) 4753 (message (concat sibs-msg " Done."))))
4377 (goto-char from))) 4754 (goto-char from)))
@@ -4636,7 +5013,7 @@ Examples:
4636 level, and expose children of subsequent topics at current 5013 level, and expose children of subsequent topics at current
4637 level *except* for the last, which should be opened completely." 5014 level *except* for the last, which should be opened completely."
4638 (list 'save-excursion 5015 (list 'save-excursion
4639 '(if (not (or (allout-goto-prefix) 5016 '(if (not (or (allout-goto-prefix-doublechecked)
4640 (allout-next-heading))) 5017 (allout-next-heading)))
4641 (error "allout-new-exposure: Can't find any outline topics")) 5018 (error "allout-new-exposure: Can't find any outline topics"))
4642 (list 'allout-expose-topic (list 'quote spec)))) 5019 (list 'allout-expose-topic (list 'quote spec))))
@@ -4758,20 +5135,20 @@ header and body. The elements of that list are:
4758 (goto-char start) 5135 (goto-char start)
4759 (beginning-of-line) 5136 (beginning-of-line)
4760 ;; Goto initial topic, and register preceeding stuff, if any: 5137 ;; Goto initial topic, and register preceeding stuff, if any:
4761 (if (> (allout-goto-prefix) start) 5138 (if (> (allout-goto-prefix-doublechecked) start)
4762 ;; First topic follows beginning point - register preliminary stuff: 5139 ;; First topic follows beginning point - register preliminary stuff:
4763 (setq result (list (list 0 "" nil 5140 (setq result (list (list 0 "" nil
4764 (buffer-substring start (1- (point))))))) 5141 (buffer-substring start (1- (point)))))))
4765 (while (and (not done) 5142 (while (and (not done)
4766 (not (eobp)) ; Loop until we've covered the region. 5143 (not (eobp)) ; Loop until we've covered the region.
4767 (not (> (point) end))) 5144 (not (> (point) end)))
4768 (setq depth (allout-recent-depth) ; Current topics depth, 5145 (setq depth allout-recent-depth ; Current topics depth,
4769 bullet (allout-recent-bullet) ; ... bullet, 5146 bullet (allout-recent-bullet) ; ... bullet,
4770 prefix (allout-recent-prefix) 5147 prefix (allout-recent-prefix)
4771 beg (progn (allout-end-of-prefix t) (point))) ; and beginning. 5148 beg (progn (allout-end-of-prefix t) (point))) ; and beginning.
4772 (setq done ; The boundary for the current topic: 5149 (setq done ; The boundary for the current topic:
4773 (not (allout-next-visible-heading 1))) 5150 (not (allout-next-visible-heading 1)))
4774 (setq new-depth (allout-recent-depth)) 5151 (setq new-depth allout-recent-depth)
4775 (setq gone-out out 5152 (setq gone-out out
4776 out (< new-depth depth)) 5153 out (< new-depth depth))
4777 (beginning-of-line) 5154 (beginning-of-line)
@@ -5040,10 +5417,10 @@ environment. Leaves point at the end of the line."
5040 ;;"\\\\\\|\\{\\|\\}\\|\\_\\|\\$\\|\\\"\\|\\&\\|\\^\\|\\-\\|\\*\\|#" 5417 ;;"\\\\\\|\\{\\|\\}\\|\\_\\|\\$\\|\\\"\\|\\&\\|\\^\\|\\-\\|\\*\\|#"
5041 end ; bounded by end-of-line 5418 end ; bounded by end-of-line
5042 1) ; no matches, move to end & return nil 5419 1) ; no matches, move to end & return nil
5043 (goto-char (match-beginning 0)) 5420 (goto-char (match-beginning 2))
5044 (insert "\\") 5421 (insert "\\")
5045 (setq end (1+ end)) 5422 (setq end (1+ end))
5046 (goto-char (1+ (match-end 0))))))) 5423 (goto-char (1+ (match-end 2)))))))
5047;;;_ > allout-insert-latex-header (buffer) 5424;;;_ > allout-insert-latex-header (buffer)
5048(defun allout-insert-latex-header (buffer) 5425(defun allout-insert-latex-header (buffer)
5049 "Insert initial LaTeX commands at point in BUFFER." 5426 "Insert initial LaTeX commands at point in BUFFER."
@@ -5089,7 +5466,7 @@ environment. Leaves point at the end of the line."
5089 (allout-latex-verb-quote (if allout-title 5466 (allout-latex-verb-quote (if allout-title
5090 (condition-case nil 5467 (condition-case nil
5091 (eval allout-title) 5468 (eval allout-title)
5092 ('error "<unnamed buffer>")) 5469 (error "<unnamed buffer>"))
5093 "Unnamed Outline")) 5470 "Unnamed Outline"))
5094 "}\n" 5471 "}\n"
5095 "\\end{center}\n\n")) 5472 "\\end{center}\n\n"))
@@ -5228,7 +5605,7 @@ auto-encryption specifics.
5228default to symmetric encryption - you must manually \(re)encrypt key-pair 5605default to symmetric encryption - you must manually \(re)encrypt key-pair
5229encrypted topics if you want them to continue to use the key-pair cipher. 5606encrypted topics if you want them to continue to use the key-pair cipher.
5230 5607
5231Level-1 topics, with prefix consisting solely of an `*' asterisk, cannot be 5608Level-one topics, with prefix consisting solely of an `*' asterisk, cannot be
5232encrypted. If you want to encrypt the contents of a top-level topic, use 5609encrypted. If you want to encrypt the contents of a top-level topic, use
5233\\[allout-shift-in] to increase its depth. 5610\\[allout-shift-in] to increase its depth.
5234 5611
@@ -5291,12 +5668,13 @@ See `allout-toggle-current-subtree-encryption' for more details."
5291 (save-excursion 5668 (save-excursion
5292 (allout-end-of-prefix t) 5669 (allout-end-of-prefix t)
5293 5670
5294 (if (= (allout-recent-depth) 1) 5671 (if (= allout-recent-depth 1)
5295 (error (concat "Cannot encrypt or decrypt level 1 topics -" 5672 (error (concat "Cannot encrypt or decrypt level 1 topics -"
5296 " shift it in to make it encryptable"))) 5673 " shift it in to make it encryptable")))
5297 5674
5298 (let* ((allout-buffer (current-buffer)) 5675 (let* ((allout-buffer (current-buffer))
5299 ;; Asses location: 5676 ;; Asses location:
5677 (bullet-pos allout-recent-prefix-beginning)
5300 (after-bullet-pos (point)) 5678 (after-bullet-pos (point))
5301 (was-encrypted 5679 (was-encrypted
5302 (progn (if (= (point-max) after-bullet-pos) 5680 (progn (if (= (point-max) after-bullet-pos)
@@ -5362,12 +5740,9 @@ See `allout-toggle-current-subtree-encryption' for more details."
5362 (delete-char 1)) 5740 (delete-char 1))
5363 ;; Add the is-encrypted bullet qualifier: 5741 ;; Add the is-encrypted bullet qualifier:
5364 (goto-char after-bullet-pos) 5742 (goto-char after-bullet-pos)
5365 (insert "*")) 5743 (insert "*"))))
5366 ) 5744 (run-hook-with-args 'allout-exposure-changed-hook
5367 ) 5745 bullet-pos subtree-end nil))))
5368 )
5369 )
5370 )
5371;;;_ > allout-encrypt-string (text decrypt allout-buffer key-type for-key 5746;;;_ > allout-encrypt-string (text decrypt allout-buffer key-type for-key
5372;;; fetch-pass &optional retried verifying 5747;;; fetch-pass &optional retried verifying
5373;;; passphrase) 5748;;; passphrase)
@@ -5512,7 +5887,8 @@ Returns the resulting string, or nil if the transformation fails."
5512 (error "decryption failed"))))) 5887 (error "decryption failed")))))
5513 5888
5514 (setq result-text 5889 (setq result-text
5515 (buffer-substring 1 (- (point-max) (if decrypt 0 1)))) 5890 (buffer-substring-no-properties
5891 1 (- (point-max) (if decrypt 0 1))))
5516 ) 5892 )
5517 5893
5518 ;; validate result - non-empty 5894 ;; validate result - non-empty
@@ -5924,17 +6300,8 @@ save. See `allout-encrypt-unencrypted-on-saves' for more info."
5924 ) 6300 )
5925 6301
5926;;;_ #9 miscellaneous 6302;;;_ #9 miscellaneous
5927;;;_ > allout-mark-topic () 6303;;;_ : Mode:
5928(defun allout-mark-topic () 6304;;;_ > outlineify-sticky ()
5929 "Put the region around topic currently containing point."
5930 (interactive)
5931 (let ((inhibit-field-text-motion t))
5932 (beginning-of-line))
5933 (allout-goto-prefix)
5934 (push-mark (point))
5935 (allout-end-of-current-subtree)
5936 (exchange-point-and-mark))
5937;;;_ > outlineify-sticky ()
5938;; outlinify-sticky is correct spelling; provide this alias for sticklers: 6305;; outlinify-sticky is correct spelling; provide this alias for sticklers:
5939;;;###autoload 6306;;;###autoload
5940(defalias 'outlinify-sticky 'outlineify-sticky) 6307(defalias 'outlinify-sticky 'outlineify-sticky)
@@ -5958,7 +6325,7 @@ setup for auto-startup."
5958 "`allout-mode' docstring: `^Hm'.")) 6325 "`allout-mode' docstring: `^Hm'."))
5959 (allout-adjust-file-variable 6326 (allout-adjust-file-variable
5960 "allout-layout" (or allout-layout '(-1 : 0)))))) 6327 "allout-layout" (or allout-layout '(-1 : 0))))))
5961;;;_ > allout-file-vars-section-data () 6328;;;_ > allout-file-vars-section-data ()
5962(defun allout-file-vars-section-data () 6329(defun allout-file-vars-section-data ()
5963 "Return data identifying the file-vars section, or nil if none. 6330 "Return data identifying the file-vars section, or nil if none.
5964 6331
@@ -5986,7 +6353,7 @@ Returns list `(beginning-point prefix-string suffix-string)'."
5986 ) 6353 )
5987 ) 6354 )
5988 ) 6355 )
5989;;;_ > allout-adjust-file-variable (varname value) 6356;;;_ > allout-adjust-file-variable (varname value)
5990(defun allout-adjust-file-variable (varname value) 6357(defun allout-adjust-file-variable (varname value)
5991 "Adjust the setting of an emacs file variable named VARNAME to VALUE. 6358 "Adjust the setting of an emacs file variable named VARNAME to VALUE.
5992 6359
@@ -6050,7 +6417,38 @@ enable-local-variables must be true for any of this to happen."
6050 ) 6417 )
6051 ) 6418 )
6052 ) 6419 )
6053;;;_ > solicit-char-in-string (prompt string &optional do-defaulting) 6420;;;_ > allout-get-configvar-values (varname)
6421(defun allout-get-configvar-values (configvar-name)
6422 "Return a list of values of the symbols in list bound to CONFIGVAR-NAME.
6423
6424The user is prompted for removal of symbols that are unbound, and they
6425otherwise are ignored.
6426
6427CONFIGVAR-NAME should be the name of the configuration variable,
6428not its value."
6429
6430 (let ((configvar-value (symbol-value configvar-name))
6431 got)
6432 (dolist (sym configvar-value)
6433 (if (not (boundp sym))
6434 (if (yes-or-no-p (format "%s entry `%s' is unbound - remove it? "
6435 configvar-name sym))
6436 (delq sym (symbol-value configvar-name)))
6437 (push (symbol-value sym) got)))
6438 (reverse got)))
6439;;;_ : Topics:
6440;;;_ > allout-mark-topic ()
6441(defun allout-mark-topic ()
6442 "Put the region around topic currently containing point."
6443 (interactive)
6444 (let ((inhibit-field-text-motion t))
6445 (beginning-of-line))
6446 (allout-goto-prefix-doublechecked)
6447 (push-mark (point))
6448 (allout-end-of-current-subtree)
6449 (exchange-point-and-mark))
6450;;;_ : UI:
6451;;;_ > solicit-char-in-string (prompt string &optional do-defaulting)
6054(defun solicit-char-in-string (prompt string &optional do-defaulting) 6452(defun solicit-char-in-string (prompt string &optional do-defaulting)
6055 "Solicit (with first arg PROMPT) choice of a character from string STRING. 6453 "Solicit (with first arg PROMPT) choice of a character from string STRING.
6056 6454
@@ -6083,7 +6481,8 @@ Optional arg DO-DEFAULTING indicates to accept empty input (CR)."
6083 ;; got something out of loop - return it: 6481 ;; got something out of loop - return it:
6084 got) 6482 got)
6085 ) 6483 )
6086;;;_ > regexp-sans-escapes (string) 6484;;;_ : Strings:
6485;;;_ > regexp-sans-escapes (string)
6087(defun regexp-sans-escapes (regexp &optional successive-backslashes) 6486(defun regexp-sans-escapes (regexp &optional successive-backslashes)
6088 "Return a copy of REGEXP with all character escapes stripped out. 6487 "Return a copy of REGEXP with all character escapes stripped out.
6089 6488
@@ -6106,7 +6505,7 @@ Optional arg SUCCESSIVE-BACKSLASHES is used internally for recursion."
6106 (regexp-sans-escapes (substring regexp 1))) 6505 (regexp-sans-escapes (substring regexp 1)))
6107 ;; Exclude first char, but maintain count: 6506 ;; Exclude first char, but maintain count:
6108 (regexp-sans-escapes (substring regexp 1) successive-backslashes)))) 6507 (regexp-sans-escapes (substring regexp 1) successive-backslashes))))
6109;;;_ > count-trailing-whitespace-region (beg end) 6508;;;_ > count-trailing-whitespace-region (beg end)
6110(defun count-trailing-whitespace-region (beg end) 6509(defun count-trailing-whitespace-region (beg end)
6111 "Return number of trailing whitespace chars between BEG and END. 6510 "Return number of trailing whitespace chars between BEG and END.
6112 6511
@@ -6117,29 +6516,25 @@ If BEG is bigger than END we return 0."
6117 (goto-char beg) 6516 (goto-char beg)
6118 (let ((count 0)) 6517 (let ((count 0))
6119 (while (re-search-forward "[ ][ ]*$" end t) 6518 (while (re-search-forward "[ ][ ]*$" end t)
6120 (goto-char (1+ (match-beginning 0))) 6519 (goto-char (1+ (match-beginning 2)))
6121 (setq count (1+ count))) 6520 (setq count (1+ count)))
6122 count)))) 6521 count))))
6123;;;_ > allout-get-configvar-values (varname) 6522;;;_ > allout-format-quote (string)
6124(defun allout-get-configvar-values (configvar-name) 6523(defun allout-format-quote (string)
6125 "Return a list of values of the symbols in list bound to CONFIGVAR-NAME. 6524 "Return a copy of string with all \"%\" characters doubled."
6126 6525 (apply 'concat
6127The user is prompted for removal of symbols that are unbound, and they 6526 (mapcar (lambda (char) (if (= char ?%) "%%" (char-to-string char)))
6128otherwise are ignored. 6527 string)))
6129 6528;;;_ : lists
6130CONFIGVAR-NAME should be the name of the configuration variable, 6529;;;_ > allout-flatten (list)
6131not its value." 6530(defun allout-flatten (list)
6132 6531 "Return a list of all atoms in list."
6133 (let ((configvar-value (symbol-value configvar-name)) 6532 ;; classic.
6134 got) 6533 (cond ((null list) nil)
6135 (dolist (sym configvar-value) 6534 ((atom (car list)) (cons (car list) (flatten (cdr list))))
6136 (if (not (boundp sym)) 6535 (t (append (flatten (car list)) (flatten (cdr list))))))
6137 (if (yes-or-no-p (format "%s entry `%s' is unbound - remove it? " 6536;;;_ : Compatability:
6138 configvar-name sym)) 6537;;;_ > allout-mark-marker to accommodate divergent emacsen:
6139 (delq sym (symbol-value configvar-name)))
6140 (push (symbol-value sym) got)))
6141 (reverse got)))
6142;;;_ > allout-mark-marker to accommodate divergent emacsen:
6143(defun allout-mark-marker (&optional force buffer) 6538(defun allout-mark-marker (&optional force buffer)
6144 "Accommodate the different signature for `mark-marker' across Emacsen. 6539 "Accommodate the different signature for `mark-marker' across Emacsen.
6145 6540
@@ -6148,7 +6543,7 @@ so pass them along when appropriate."
6148 (if (featurep 'xemacs) 6543 (if (featurep 'xemacs)
6149 (apply 'mark-marker force buffer) 6544 (apply 'mark-marker force buffer)
6150 (mark-marker))) 6545 (mark-marker)))
6151;;;_ > subst-char-in-string if necessary 6546;;;_ > subst-char-in-string if necessary
6152(if (not (fboundp 'subst-char-in-string)) 6547(if (not (fboundp 'subst-char-in-string))
6153 (defun subst-char-in-string (fromchar tochar string &optional inplace) 6548 (defun subst-char-in-string (fromchar tochar string &optional inplace)
6154 "Replace FROMCHAR with TOCHAR in STRING each time it occurs. 6549 "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
@@ -6160,10 +6555,10 @@ Unless optional argument INPLACE is non-nil, return a new string."
6160 (if (eq (aref newstr i) fromchar) 6555 (if (eq (aref newstr i) fromchar)
6161 (aset newstr i tochar))) 6556 (aset newstr i tochar)))
6162 newstr))) 6557 newstr)))
6163;;;_ > wholenump if necessary 6558;;;_ > wholenump if necessary
6164(if (not (fboundp 'wholenump)) 6559(if (not (fboundp 'wholenump))
6165 (defalias 'wholenump 'natnump)) 6560 (defalias 'wholenump 'natnump))
6166;;;_ > remove-overlays if necessary 6561;;;_ > remove-overlays if necessary
6167(if (not (fboundp 'remove-overlays)) 6562(if (not (fboundp 'remove-overlays))
6168 (defun remove-overlays (&optional beg end name val) 6563 (defun remove-overlays (&optional beg end name val)
6169 "Clear BEG and END of overlays whose property NAME has value VAL. 6564 "Clear BEG and END of overlays whose property NAME has value VAL.
@@ -6190,7 +6585,7 @@ BEG and END default respectively to the beginning and end of buffer."
6190 (move-overlay o end (overlay-end o)) 6585 (move-overlay o end (overlay-end o))
6191 (delete-overlay o))))))) 6586 (delete-overlay o)))))))
6192 ) 6587 )
6193;;;_ > copy-overlay if necessary - xemacs ~ 21.4 6588;;;_ > copy-overlay if necessary - xemacs ~ 21.4
6194(if (not (fboundp 'copy-overlay)) 6589(if (not (fboundp 'copy-overlay))
6195 (defun copy-overlay (o) 6590 (defun copy-overlay (o)
6196 "Return a copy of overlay O." 6591 "Return a copy of overlay O."
@@ -6202,7 +6597,7 @@ BEG and END default respectively to the beginning and end of buffer."
6202 (while props 6597 (while props
6203 (overlay-put o1 (pop props) (pop props))) 6598 (overlay-put o1 (pop props) (pop props)))
6204 o1))) 6599 o1)))
6205;;;_ > add-to-invisibility-spec if necessary - xemacs ~ 21.4 6600;;;_ > add-to-invisibility-spec if necessary - xemacs ~ 21.4
6206(if (not (fboundp 'add-to-invisibility-spec)) 6601(if (not (fboundp 'add-to-invisibility-spec))
6207 (defun add-to-invisibility-spec (element) 6602 (defun add-to-invisibility-spec (element)
6208 "Add ELEMENT to `buffer-invisibility-spec'. 6603 "Add ELEMENT to `buffer-invisibility-spec'.
@@ -6212,14 +6607,14 @@ that can be added."
6212 (setq buffer-invisibility-spec (list t))) 6607 (setq buffer-invisibility-spec (list t)))
6213 (setq buffer-invisibility-spec 6608 (setq buffer-invisibility-spec
6214 (cons element buffer-invisibility-spec)))) 6609 (cons element buffer-invisibility-spec))))
6215;;;_ > remove-from-invisibility-spec if necessary - xemacs ~ 21.4 6610;;;_ > remove-from-invisibility-spec if necessary - xemacs ~ 21.4
6216(if (not (fboundp 'remove-from-invisibility-spec)) 6611(if (not (fboundp 'remove-from-invisibility-spec))
6217 (defun remove-from-invisibility-spec (element) 6612 (defun remove-from-invisibility-spec (element)
6218 "Remove ELEMENT from `buffer-invisibility-spec'." 6613 "Remove ELEMENT from `buffer-invisibility-spec'."
6219 (if (consp buffer-invisibility-spec) 6614 (if (consp buffer-invisibility-spec)
6220 (setq buffer-invisibility-spec (delete element 6615 (setq buffer-invisibility-spec (delete element
6221 buffer-invisibility-spec))))) 6616 buffer-invisibility-spec)))))
6222;;;_ > move-beginning-of-line if necessary - older emacs, xemacs 6617;;;_ > move-beginning-of-line if necessary - older emacs, xemacs
6223(if (not (fboundp 'move-beginning-of-line)) 6618(if (not (fboundp 'move-beginning-of-line))
6224 (defun move-beginning-of-line (arg) 6619 (defun move-beginning-of-line (arg)
6225 "Move point to beginning of current line as displayed. 6620 "Move point to beginning of current line as displayed.
@@ -6243,7 +6638,7 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
6243 (skip-chars-backward "^\n")) 6638 (skip-chars-backward "^\n"))
6244 (vertical-motion 0)) 6639 (vertical-motion 0))
6245) 6640)
6246;;;_ > move-end-of-line if necessary - older emacs, xemacs 6641;;;_ > move-end-of-line if necessary - older emacs, xemacs
6247(if (not (fboundp 'move-end-of-line)) 6642(if (not (fboundp 'move-end-of-line))
6248 (defun move-end-of-line (arg) 6643 (defun move-end-of-line (arg)
6249 "Move point to end of current line as displayed. 6644 "Move point to end of current line as displayed.
@@ -6283,7 +6678,7 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
6283 (setq arg 1) 6678 (setq arg 1)
6284 (setq done t))))))) 6679 (setq done t)))))))
6285 ) 6680 )
6286;;;_ > line-move-invisible-p if necessary 6681;;;_ > line-move-invisible-p if necessary
6287(if (not (fboundp 'line-move-invisible-p)) 6682(if (not (fboundp 'line-move-invisible-p))
6288 (defun line-move-invisible-p (pos) 6683 (defun line-move-invisible-p (pos)
6289 "Return non-nil if the character after POS is currently invisible." 6684 "Return non-nil if the character after POS is currently invisible."