diff options
| author | Chong Yidong | 2006-09-14 17:52:07 +0000 |
|---|---|---|
| committer | Chong Yidong | 2006-09-14 17:52:07 +0000 |
| commit | d83509985e17a19fe5771422d8620467a190e816 (patch) | |
| tree | 89fc86aa82404b27a8080edc9e01dadb3cc2d0b5 /lisp | |
| parent | bcb0eabd9baa67b6ad6308c036ff4c00d3000213 (diff) | |
| download | emacs-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/ChangeLog | 111 | ||||
| -rw-r--r-- | lisp/allout.el | 1273 |
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 @@ | |||
| 1 | 2006-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 | |||
| 1 | 2006-09-14 Chong Yidong <cyd@stupidchicken.com> | 112 | 2006-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 | |||
| 854 | This expression is used to search for depth-specific topic | ||
| 855 | headers at depth 2 and greater. Use `allout-depth-one-regexp' | ||
| 856 | for to seek topics at depth one. | ||
| 857 | |||
| 858 | This var is set according to the user configuration vars by | ||
| 859 | `set-allout-regexp'. It is prepared with format strings for two | ||
| 860 | decimal numbers, which should each be one less than the depth of the | ||
| 861 | topic 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 | |||
| 867 | This var is set according to the user configuration vars by | ||
| 868 | `set-allout-regexp'. It is prepared with format strings for two | ||
| 869 | decimal numbers, which should each be one less than the depth of the | ||
| 870 | topic 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 | ||
| 854 | This is properly set when `allout-regexp' is produced by | 876 | This is properly set by `set-allout-regexp'.") |
| 855 | `set-allout-regexp', so that (match-beginning 2) and (match-end | ||
| 856 | 2) 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 | ||
| 895 | Verified with `allout-aberrant-container-p'. This check's usefulness is | ||
| 896 | limited to shallow prospects, because the determination of aberrance | ||
| 897 | depends on the mistaken item being followed by a legitimate item of | ||
| 898 | excessively 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 | ||
| 963 | Works with respect to `allout-plain-bullets-string' and | 989 | Works with respect to `allout-plain-bullets-string' and |
| 964 | `allout-distinctive-bullets-string'." | 990 | `allout-distinctive-bullets-string'. |
| 991 | |||
| 992 | Also 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 | ||
| 2001 | This before-change handler is used only where modification-hooks | 2092 | This before-change handler is used only where modification-hooks |
| 2002 | overlay property is not supported." | 2093 | overlay 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 | ||
| 2046 | For reference by `allout-recent' funcs. Returns BEGINNING." | 2146 | For 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 | ||
| 2053 | All outline functions which directly do string matches to assess | 2165 | All 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 |
| 2056 | to return the current depth." | 2168 | to 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 | ||
| 2065 | All outline functions which directly do string matches to assess | 2175 | All outline functions which directly do string matches to assess |
| 2066 | headings set the variables `allout-recent-prefix-beginning' and | 2176 | headings 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 |
| 2068 | to return the current depth." | 2178 | to 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 | |||
| 2076 | headings set the variables `allout-recent-prefix-beginning' and | 2186 | headings 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 |
| 2078 | to return the current depth of the most recently matched topic." | 2188 | to 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 | |||
| 2219 | Discontinuous means an immediate offspring that is nested more | ||
| 2220 | than one level deeper than the topic. | ||
| 2221 | |||
| 2222 | If topic has no offspring, then the next sibling with offspring will | ||
| 2223 | determine whether or not this one is determined to be aberrant. | ||
| 2224 | |||
| 2225 | If true, then the allout-recent-* settings are calibrated on the | ||
| 2226 | offspring that qaulifies it as aberrant, ie with depth that | ||
| 2227 | exceeds 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 | ||
| 2273 | Returns the location of the heading, or nil if none found." | 2436 | Returns the location of the heading, or nil if none found. |
| 2274 | 2437 | ||
| 2275 | (if (and (bobp) (not (eobp)) (looking-at allout-regexp)) | 2438 | We 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 | ||
| 2293 | Return the location of the beginning of the heading, or nil if not found." | 2458 | Return the location of the beginning of the heading, or nil if not found. |
| 2294 | 2459 | ||
| 2295 | '(if (bobp) | 2460 | We 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 | |||
| 2348 | routines need assess the structure only once, and then use the chart | 2516 | routines need assess the structure only once, and then use the chart |
| 2349 | for their elaborate manipulations. | 2517 | for their elaborate manipulations. |
| 2350 | 2518 | ||
| 2351 | Topics are entered in the chart so the last one is at the car. | 2519 | The chart entries for the topics are in reverse order, so the |
| 2352 | The entry for each topic consists of an integer indicating the point | 2520 | last topic is listed first. The entry for each topic consists of |
| 2353 | at the beginning of the topic. Charts for offspring consists of a | 2521 | an integer indicating the point at the beginning of the topic |
| 2354 | list containing, recursively, the charts for the respective subtopics. | 2522 | prefix. Charts for offspring consists of a list containing, |
| 2355 | The chart for a topics' offspring precedes the entry for the topic | 2523 | recursively, the charts for the respective subtopics. The chart |
| 2356 | itself. | 2524 | for a topics' offspring precedes the entry for the topic itself. |
| 2357 | 2525 | ||
| 2358 | The other function parameters are for internal recursion, and should | 2526 | The other function parameters are for internal recursion, and should |
| 2359 | not be specified by external callers. ORIG-DEPTH is depth of topic at | 2527 | not 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." | |||
| 2437 | Effectively a top-level chart of siblings. See `allout-chart-subtree' | 2605 | Effectively a top-level chart of siblings. See `allout-chart-subtree' |
| 2438 | for an explanation of charts." | 2606 | for 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 | |||
| 2697 | Like `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." | |||
| 2530 | If optional IGNORE-DECORATIONS is non-nil, put just after bullet, | 2708 | If optional IGNORE-DECORATIONS is non-nil, put just after bullet, |
| 2531 | otherwise skip white space between bullet and ensuing text." | 2709 | otherwise 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." | |||
| 2579 | Returns that character position." | 2753 | Returns 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 | |||
| 2719 | Positions on heading line of containing topic. Error if unable to | ||
| 2720 | ascend that far, or nil if unable to ascend but optional arg | ||
| 2721 | DONT-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 | ||
| 2757 | Go backward if optional arg BACKWARD is non-nil. | 2903 | Go backward if optional arg BACKWARD is non-nil. |
| 2758 | 2904 | ||
| 2759 | Return depth if successful, nil otherwise." | 2905 | Return 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 | |||
| 2944 | Traverse at optional DEPTH, or current depth if none specified. | ||
| 2945 | |||
| 2946 | Go backward if optional arg BACKWARD is non-nil. | ||
| 2947 | |||
| 2948 | Return the start point of the new topic if successful, nil otherwise. | ||
| 2949 | |||
| 2950 | Costs 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 | |||
| 2958 | It is an increasingly big win when there are many intervening | ||
| 2959 | offspring before the next sibling, however, so | ||
| 2960 | `allout-next-sibling' resorts to this if it finds itself in that | ||
| 2961 | situation." | ||
| 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. | |||
| 2845 | A heading line is one that starts with a `*' (or that `allout-regexp' | 3083 | A heading line is one that starts with a `*' (or that `allout-regexp' |
| 2846 | matches)." | 3084 | matches)." |
| 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 | ||
| 2978 | Returns the qualifying command, if any, else nil." | 3204 | Returns 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 | ||
| 3633 | Descends into invisible as well as visible topics, however. | 3877 | Descends into invisible as well as visible topics, however. |
| 3634 | 3878 | ||
| 3879 | When optional sans-offspring is non-nil, subtopics are not | ||
| 3880 | shifted. \(Shifting a topic outwards without shifting its | ||
| 3881 | offspring is disallowed, since this would create a \"containment | ||
| 3882 | discontinuity\", where the depth difference between a topic and | ||
| 3883 | its immediate offspring is greater than one.) | ||
| 3884 | |||
| 3635 | With repeat count, shift topic depth by that amount." | 3885 | With 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. | |||
| 3663 | First arg RELATIVE-DEPTH means to shift the depth of the entire | 3914 | First arg RELATIVE-DEPTH means to shift the depth of the entire |
| 3664 | topic that amount. | 3915 | topic that amount. |
| 3665 | 3916 | ||
| 3666 | The rest of the args are for internal recursive use by the function | 3917 | Several subsequent args are for internal recursive use by the function |
| 3667 | itself. The are STARTING-DEPTH, STARTING-POINT, and INDEX." | 3918 | itself: STARTING-DEPTH, STARTING-POINT, and INDEX. |
| 3919 | |||
| 3920 | Finally, if optional SANS-OFFSPRING is non-nil then the offspring | ||
| 3921 | are not shifted. \(Shifting a topic outwards without shifting | ||
| 3922 | its offspring is disallowed, since this would create a | ||
| 3923 | \"containment discontinuity\", where the depth difference between | ||
| 3924 | a 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 | |||
| 4078 | With a negative argument, the item is shifted out using | ||
| 4079 | `allout-shift-out', instead. | ||
| 4080 | |||
| 4081 | With an argument greater than one, shift-in the item but not its | ||
| 4082 | offspring, making the item into a sibling of its former children, | ||
| 4083 | and a child of sibling that formerly preceeded it. | ||
| 4084 | |||
| 4085 | You are not allowed to shift the first offspring of a topic | ||
| 4086 | inwards, because that would yield a \"containment | ||
| 4087 | discontinuity\", where the depth difference between a topic and | ||
| 4088 | its immediate offspring is greater than one. The first topic in | ||
| 4089 | the file can be adjusted to any positive depth, however." | ||
| 3798 | 4090 | ||
| 3799 | We disallow shifts that would result in the topic having a depth more than | ||
| 3800 | one level greater than the immediately previous topic, to avoid containment | ||
| 3801 | discontinuity. The first topic in the file can be adjusted to any positive | ||
| 3802 | depth, 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. |
| 4117 | This will make the item a sibling of its former container. | ||
| 4118 | |||
| 4119 | With a negative argument, the item is shifted in using | ||
| 4120 | `allout-shift-in', instead. | ||
| 4121 | |||
| 4122 | With an argument greater than one, shift-out the item's offspring | ||
| 4123 | but not the item itself, making the former children siblings of | ||
| 4124 | the item. | ||
| 3839 | 4125 | ||
| 3840 | We disallow shifts that would result in the topic having a depth more than | 4126 | With an argument greater than 1, the item's offspring are shifted |
| 3841 | one level greater than the immediately previous topic, to avoid containment | 4127 | out without shifting the item. This will make the immediate |
| 3842 | discontinuity. The first topic in the file can be adjusted to any positive | 4128 | subtopics into siblings of the item." |
| 3843 | depth, 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 | ||
| 3892 | Completely collapsed topics are marked as such, for re-collapse | 4197 | Topic exposure is marked with text-properties, to be used by |
| 3893 | when yank with allout-yank into an outline as a heading." | 4198 | allout-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. | |||
| 5228 | default to symmetric encryption - you must manually \(re)encrypt key-pair | 5605 | default to symmetric encryption - you must manually \(re)encrypt key-pair |
| 5229 | encrypted topics if you want them to continue to use the key-pair cipher. | 5606 | encrypted topics if you want them to continue to use the key-pair cipher. |
| 5230 | 5607 | ||
| 5231 | Level-1 topics, with prefix consisting solely of an `*' asterisk, cannot be | 5608 | Level-one topics, with prefix consisting solely of an `*' asterisk, cannot be |
| 5232 | encrypted. If you want to encrypt the contents of a top-level topic, use | 5609 | encrypted. 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 | |||
| 6424 | The user is prompted for removal of symbols that are unbound, and they | ||
| 6425 | otherwise are ignored. | ||
| 6426 | |||
| 6427 | CONFIGVAR-NAME should be the name of the configuration variable, | ||
| 6428 | not 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 | |
| 6127 | The user is prompted for removal of symbols that are unbound, and they | 6526 | (mapcar (lambda (char) (if (= char ?%) "%%" (char-to-string char))) |
| 6128 | otherwise are ignored. | 6527 | string))) |
| 6129 | 6528 | ;;;_ : lists | |
| 6130 | CONFIGVAR-NAME should be the name of the configuration variable, | 6529 | ;;;_ > allout-flatten (list) |
| 6131 | not 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." |