diff options
| author | Dan Nicolaescu | 2007-10-29 23:10:09 +0000 |
|---|---|---|
| committer | Dan Nicolaescu | 2007-10-29 23:10:09 +0000 |
| commit | 2a1408fdca7e448cb5c94116f1718917e915dea4 (patch) | |
| tree | 384488dc89c2eb880895e3b0ed796c4125c63bfe | |
| parent | 69c2d9146b981ab3fbd63d4be326aeb62572a797 (diff) | |
| download | emacs-2a1408fdca7e448cb5c94116f1718917e915dea4.tar.gz emacs-2a1408fdca7e448cb5c94116f1718917e915dea4.zip | |
* allout.el (allout-command-prefix, allout-inhibit-auto-fill):
Relocate in file.
(allout-doublecheck-at-and-shallower): Increase to include
slightly greater depths, since yank interaction is now ok. Also,
elaborate the docstring to explain the situation.
(produce-allout-mode-map, allout-hotspot-key-handler): Use vconcat
instead of concat, so we accommodate key sequences expressed as
vectors as well as strings and lists.
(allout-flag-region, allout-hide-by-annotation): Make the
hidden-text overlays 'front-advance.
(allout-overlay-insert-in-front-handler): Correct docstring's
grammar.
(allout-aberrant-container-p, allout-on-current-heading-p)
(allout-e-o-prefix-p, allout-next-heading)
(allout-previous-heading, allout-goto-prefix)
(allout-end-of-prefix, allout-next-sibling-leap)
(allout-next-visible-heading, allout-auto-fill)
(allout-rebullet-heading, allout-kill-line, allout-kill-topic)
(allout-yank-processing, allout-resolve-xref)
(allout-current-topic-collapsed-p, allout-hide-region-body)
(allout-latex-verbatim-quote-curr-line, allout-encrypt-string)
(allout-encrypted-topic-p, allout-next-topic-pending-encryption)
(count-trailing-whitespace-region): Preserve match data, so allout
outline navigation doesn't disrupt other emacs operations.
(allout-beginning-of-line): Retreat to the beginning of the hidden
text, so fields are respected (for submodes that care).
(allout-end-of-line): Preserve mark activation status when
jumping.
(allout-open-topic): Account for opening after a child that
contains a hidden trailing newline. Preserve match data. Run
allout-structure-added-hook
(allout-encrypt-decrypted): Preserve match data.
(allout-toggle-current-subtree-exposure): Add new interactive
function for toggle subtree exposure - suggested by tassilo.
(move-beginning-of-line, move-end-of-line): Don't use
line-move-invisible-p, it's obsolete - substitute the code,
instead.
| -rw-r--r-- | lisp/ChangeLog | 40 | ||||
| -rw-r--r-- | lisp/allout.el | 1224 |
2 files changed, 687 insertions, 577 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 11db973259b..0299bb9b2f6 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,43 @@ | |||
| 1 | 2007-10-29 Ken Manheimer <ken.manheimer@gmail.com> | ||
| 2 | |||
| 3 | * allout.el (allout-command-prefix, allout-inhibit-auto-fill): | ||
| 4 | Relocate in file. | ||
| 5 | (allout-doublecheck-at-and-shallower): Increase to include | ||
| 6 | slightly greater depths, since yank interaction is now ok. Also, | ||
| 7 | elaborate the docstring to explain the situation. | ||
| 8 | (produce-allout-mode-map, allout-hotspot-key-handler): Use vconcat | ||
| 9 | instead of concat, so we accommodate key sequences expressed as | ||
| 10 | vectors as well as strings and lists. | ||
| 11 | (allout-flag-region, allout-hide-by-annotation): Make the | ||
| 12 | hidden-text overlays 'front-advance. | ||
| 13 | (allout-overlay-insert-in-front-handler): Correct docstring's | ||
| 14 | grammar. | ||
| 15 | (allout-aberrant-container-p, allout-on-current-heading-p) | ||
| 16 | (allout-e-o-prefix-p, allout-next-heading) | ||
| 17 | (allout-previous-heading, allout-goto-prefix) | ||
| 18 | (allout-end-of-prefix, allout-next-sibling-leap) | ||
| 19 | (allout-next-visible-heading, allout-auto-fill) | ||
| 20 | (allout-rebullet-heading, allout-kill-line, allout-kill-topic) | ||
| 21 | (allout-yank-processing, allout-resolve-xref) | ||
| 22 | (allout-current-topic-collapsed-p, allout-hide-region-body) | ||
| 23 | (allout-latex-verbatim-quote-curr-line, allout-encrypt-string) | ||
| 24 | (allout-encrypted-topic-p, allout-next-topic-pending-encryption) | ||
| 25 | (count-trailing-whitespace-region): Preserve match data, so allout | ||
| 26 | outline navigation doesn't disrupt other emacs operations. | ||
| 27 | (allout-beginning-of-line): Retreat to the beginning of the hidden | ||
| 28 | text, so fields are respected (for submodes that care). | ||
| 29 | (allout-end-of-line): Preserve mark activation status when | ||
| 30 | jumping. | ||
| 31 | (allout-open-topic): Account for opening after a child that | ||
| 32 | contains a hidden trailing newline. Preserve match data. Run | ||
| 33 | allout-structure-added-hook | ||
| 34 | (allout-encrypt-decrypted): Preserve match data. | ||
| 35 | (allout-toggle-current-subtree-exposure): Add new interactive | ||
| 36 | function for toggle subtree exposure - suggested by tassilo. | ||
| 37 | (move-beginning-of-line, move-end-of-line): Don't use | ||
| 38 | line-move-invisible-p, it's obsolete - substitute the code, | ||
| 39 | instead. | ||
| 40 | |||
| 1 | 2007-10-29 Dan Nicolaescu <dann@ics.uci.edu> | 41 | 2007-10-29 Dan Nicolaescu <dann@ics.uci.edu> |
| 2 | 42 | ||
| 3 | * textmodes/flyspell.el (message-signature-separator): | 43 | * textmodes/flyspell.el (message-signature-separator): |
diff --git a/lisp/allout.el b/lisp/allout.el index 49dfef21547..8878c56735f 100644 --- a/lisp/allout.el +++ b/lisp/allout.el | |||
| @@ -109,6 +109,65 @@ | |||
| 109 | 109 | ||
| 110 | ;;;_ + Layout, Mode, and Topic Header Configuration | 110 | ;;;_ + Layout, Mode, and Topic Header Configuration |
| 111 | 111 | ||
| 112 | ;;;_ = allout-command-prefix | ||
| 113 | (defcustom allout-command-prefix "\C-c " | ||
| 114 | "*Key sequence to be used as prefix for outline mode command key bindings. | ||
| 115 | |||
| 116 | Default is '\C-c<space>'; just '\C-c' is more short-and-sweet, if you're | ||
| 117 | willing to let allout use a bunch of \C-c keybindings." | ||
| 118 | :type 'string | ||
| 119 | :group 'allout) | ||
| 120 | ;;;_ = allout-keybindings-list | ||
| 121 | ;;; You have to reactivate allout-mode - `(allout-mode t)' - to | ||
| 122 | ;;; institute changes to this var. | ||
| 123 | (defvar allout-keybindings-list () | ||
| 124 | "*List of `allout-mode' key / function bindings, for `allout-mode-map'. | ||
| 125 | |||
| 126 | String or vector key will be prefaced with `allout-command-prefix', | ||
| 127 | unless optional third, non-nil element is present.") | ||
| 128 | (setq allout-keybindings-list | ||
| 129 | '( | ||
| 130 | ; Motion commands: | ||
| 131 | ("\C-n" allout-next-visible-heading) | ||
| 132 | ("\C-p" allout-previous-visible-heading) | ||
| 133 | ("\C-u" allout-up-current-level) | ||
| 134 | ("\C-f" allout-forward-current-level) | ||
| 135 | ("\C-b" allout-backward-current-level) | ||
| 136 | ("\C-a" allout-beginning-of-current-entry) | ||
| 137 | ("\C-e" allout-end-of-entry) | ||
| 138 | ; Exposure commands: | ||
| 139 | ("\C-i" allout-show-children) | ||
| 140 | ("\C-s" allout-show-current-subtree) | ||
| 141 | ("\C-h" allout-hide-current-subtree) | ||
| 142 | ("\C-t" allout-toggle-current-subtree-exposure) | ||
| 143 | ("h" allout-hide-current-subtree) | ||
| 144 | ("\C-o" allout-show-current-entry) | ||
| 145 | ("!" allout-show-all) | ||
| 146 | ("x" allout-toggle-current-subtree-encryption) | ||
| 147 | ; Alteration commands: | ||
| 148 | (" " allout-open-sibtopic) | ||
| 149 | ("." allout-open-subtopic) | ||
| 150 | ("," allout-open-supertopic) | ||
| 151 | ("'" allout-shift-in) | ||
| 152 | (">" allout-shift-in) | ||
| 153 | ("<" allout-shift-out) | ||
| 154 | ("\C-m" allout-rebullet-topic) | ||
| 155 | ("*" allout-rebullet-current-heading) | ||
| 156 | ("#" allout-number-siblings) | ||
| 157 | ("\C-k" allout-kill-line t) | ||
| 158 | ("\M-k" allout-copy-line-as-kill t) | ||
| 159 | ("\C-y" allout-yank t) | ||
| 160 | ("\M-y" allout-yank-pop t) | ||
| 161 | ("\C-k" allout-kill-topic) | ||
| 162 | ("\M-k" allout-copy-topic-as-kill) | ||
| 163 | ; Miscellaneous commands: | ||
| 164 | ;([?\C-\ ] allout-mark-topic) | ||
| 165 | ("@" allout-resolve-xref) | ||
| 166 | ("=c" allout-copy-exposed-to-buffer) | ||
| 167 | ("=i" allout-indented-exposed-to-buffer) | ||
| 168 | ("=t" allout-latexify-exposed) | ||
| 169 | ("=p" allout-flatten-exposed-to-buffer))) | ||
| 170 | |||
| 112 | ;;;_ = allout-auto-activation | 171 | ;;;_ = allout-auto-activation |
| 113 | (defcustom allout-auto-activation nil | 172 | (defcustom allout-auto-activation nil |
| 114 | "*Regulates auto-activation modality of allout outlines - see `allout-init'. | 173 | "*Regulates auto-activation modality of allout outlines - see `allout-init'. |
| @@ -204,6 +263,54 @@ is modulo the setting of `allout-use-mode-specific-leader', which see." | |||
| 204 | (const :tag "- (expose topic body but not offspring)" -) | 263 | (const :tag "- (expose topic body but not offspring)" -) |
| 205 | (allout-layout-type :tag "<Nested layout>")))) | 264 | (allout-layout-type :tag "<Nested layout>")))) |
| 206 | 265 | ||
| 266 | ;;;_ = allout-inhibit-auto-fill | ||
| 267 | (defcustom allout-inhibit-auto-fill nil | ||
| 268 | "*If non-nil, auto-fill will be inhibited in the allout buffers. | ||
| 269 | |||
| 270 | You can customize this setting to set it for all allout buffers, or set it | ||
| 271 | in individual buffers if you want to inhibit auto-fill only in particular | ||
| 272 | buffers. (You could use a function on `allout-mode-hook' to inhibit | ||
| 273 | auto-fill according, eg, to the major mode.) | ||
| 274 | |||
| 275 | If you don't set this and auto-fill-mode is enabled, allout will use the | ||
| 276 | value that `normal-auto-fill-function', if any, when allout mode starts, or | ||
| 277 | else allout's special hanging-indent maintaining auto-fill function, | ||
| 278 | `allout-auto-fill'." | ||
| 279 | :type 'boolean | ||
| 280 | :group 'allout) | ||
| 281 | (make-variable-buffer-local 'allout-inhibit-auto-fill) | ||
| 282 | ;;;_ = allout-use-hanging-indents | ||
| 283 | (defcustom allout-use-hanging-indents t | ||
| 284 | "*If non-nil, topic body text auto-indent defaults to indent of the header. | ||
| 285 | Ie, it is indented to be just past the header prefix. This is | ||
| 286 | relevant mostly for use with indented-text-mode, or other situations | ||
| 287 | where auto-fill occurs." | ||
| 288 | :type 'boolean | ||
| 289 | :group 'allout) | ||
| 290 | (make-variable-buffer-local 'allout-use-hanging-indents) | ||
| 291 | ;;;###autoload | ||
| 292 | (put 'allout-use-hanging-indents 'safe-local-variable | ||
| 293 | (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil))))) | ||
| 294 | ;;;_ = allout-reindent-bodies | ||
| 295 | (defcustom allout-reindent-bodies (if allout-use-hanging-indents | ||
| 296 | 'text) | ||
| 297 | "*Non-nil enables auto-adjust of topic body hanging indent with depth shifts. | ||
| 298 | |||
| 299 | When active, topic body lines that are indented even with or beyond | ||
| 300 | their topic header are reindented to correspond with depth shifts of | ||
| 301 | the header. | ||
| 302 | |||
| 303 | A value of t enables reindent in non-programming-code buffers, ie | ||
| 304 | those that do not have the variable `comment-start' set. A value of | ||
| 305 | `force' enables reindent whether or not `comment-start' is set." | ||
| 306 | :type '(choice (const nil) (const t) (const text) (const force)) | ||
| 307 | :group 'allout) | ||
| 308 | |||
| 309 | (make-variable-buffer-local 'allout-reindent-bodies) | ||
| 310 | ;;;###autoload | ||
| 311 | (put 'allout-reindent-bodies 'safe-local-variable | ||
| 312 | '(lambda (x) (memq x '(nil t text force)))) | ||
| 313 | |||
| 207 | ;;;_ = allout-show-bodies | 314 | ;;;_ = allout-show-bodies |
| 208 | (defcustom allout-show-bodies nil | 315 | (defcustom allout-show-bodies nil |
| 209 | "*If non-nil, show entire body when exposing a topic, rather than | 316 | "*If non-nil, show entire body when exposing a topic, rather than |
| @@ -667,115 +774,6 @@ See `allout-run-unit-tests' to see what's run." | |||
| 667 | 774 | ||
| 668 | ;;;_ + Miscellaneous customization | 775 | ;;;_ + Miscellaneous customization |
| 669 | 776 | ||
| 670 | ;;;_ = allout-command-prefix | ||
| 671 | (defcustom allout-command-prefix "\C-c " | ||
| 672 | "*Key sequence to be used as prefix for outline mode command key bindings. | ||
| 673 | |||
| 674 | Default is '\C-c<space>'; just '\C-c' is more short-and-sweet, if you're | ||
| 675 | willing to let allout use a bunch of \C-c keybindings." | ||
| 676 | :type 'string | ||
| 677 | :group 'allout) | ||
| 678 | |||
| 679 | ;;;_ = allout-keybindings-list | ||
| 680 | ;;; You have to reactivate allout-mode - `(allout-mode t)' - to | ||
| 681 | ;;; institute changes to this var. | ||
| 682 | (defvar allout-keybindings-list () | ||
| 683 | "*List of `allout-mode' key / function bindings, for `allout-mode-map'. | ||
| 684 | |||
| 685 | String or vector key will be prefaced with `allout-command-prefix', | ||
| 686 | unless optional third, non-nil element is present.") | ||
| 687 | (setq allout-keybindings-list | ||
| 688 | '( | ||
| 689 | ; Motion commands: | ||
| 690 | ("\C-n" allout-next-visible-heading) | ||
| 691 | ("\C-p" allout-previous-visible-heading) | ||
| 692 | ("\C-u" allout-up-current-level) | ||
| 693 | ("\C-f" allout-forward-current-level) | ||
| 694 | ("\C-b" allout-backward-current-level) | ||
| 695 | ("\C-a" allout-beginning-of-current-entry) | ||
| 696 | ("\C-e" allout-end-of-entry) | ||
| 697 | ; Exposure commands: | ||
| 698 | ("\C-i" allout-show-children) | ||
| 699 | ("\C-s" allout-show-current-subtree) | ||
| 700 | ("\C-h" allout-hide-current-subtree) | ||
| 701 | ("h" allout-hide-current-subtree) | ||
| 702 | ("\C-o" allout-show-current-entry) | ||
| 703 | ("!" allout-show-all) | ||
| 704 | ("x" allout-toggle-current-subtree-encryption) | ||
| 705 | ; Alteration commands: | ||
| 706 | (" " allout-open-sibtopic) | ||
| 707 | ("." allout-open-subtopic) | ||
| 708 | ("," allout-open-supertopic) | ||
| 709 | ("'" allout-shift-in) | ||
| 710 | (">" allout-shift-in) | ||
| 711 | ("<" allout-shift-out) | ||
| 712 | ("\C-m" allout-rebullet-topic) | ||
| 713 | ("*" allout-rebullet-current-heading) | ||
| 714 | ("#" allout-number-siblings) | ||
| 715 | ("\C-k" allout-kill-line t) | ||
| 716 | ("\M-k" allout-copy-line-as-kill t) | ||
| 717 | ("\C-y" allout-yank t) | ||
| 718 | ("\M-y" allout-yank-pop t) | ||
| 719 | ("\C-k" allout-kill-topic) | ||
| 720 | ("\M-k" allout-copy-topic-as-kill) | ||
| 721 | ; Miscellaneous commands: | ||
| 722 | ;([?\C-\ ] allout-mark-topic) | ||
| 723 | ("@" allout-resolve-xref) | ||
| 724 | ("=c" allout-copy-exposed-to-buffer) | ||
| 725 | ("=i" allout-indented-exposed-to-buffer) | ||
| 726 | ("=t" allout-latexify-exposed) | ||
| 727 | ("=p" allout-flatten-exposed-to-buffer))) | ||
| 728 | |||
| 729 | ;;;_ = allout-inhibit-auto-fill | ||
| 730 | (defcustom allout-inhibit-auto-fill nil | ||
| 731 | "*If non-nil, auto-fill will be inhibited in the allout buffers. | ||
| 732 | |||
| 733 | You can customize this setting to set it for all allout buffers, or set it | ||
| 734 | in individual buffers if you want to inhibit auto-fill only in particular | ||
| 735 | buffers. (You could use a function on `allout-mode-hook' to inhibit | ||
| 736 | auto-fill according, eg, to the major mode.) | ||
| 737 | |||
| 738 | If you don't set this and auto-fill-mode is enabled, allout will use the | ||
| 739 | value that `normal-auto-fill-function', if any, when allout mode starts, or | ||
| 740 | else allout's special hanging-indent maintaining auto-fill function, | ||
| 741 | `allout-auto-fill'." | ||
| 742 | :type 'boolean | ||
| 743 | :group 'allout) | ||
| 744 | (make-variable-buffer-local 'allout-inhibit-auto-fill) | ||
| 745 | |||
| 746 | ;;;_ = allout-use-hanging-indents | ||
| 747 | (defcustom allout-use-hanging-indents t | ||
| 748 | "*If non-nil, topic body text auto-indent defaults to indent of the header. | ||
| 749 | Ie, it is indented to be just past the header prefix. This is | ||
| 750 | relevant mostly for use with indented-text-mode, or other situations | ||
| 751 | where auto-fill occurs." | ||
| 752 | :type 'boolean | ||
| 753 | :group 'allout) | ||
| 754 | (make-variable-buffer-local 'allout-use-hanging-indents) | ||
| 755 | ;;;###autoload | ||
| 756 | (put 'allout-use-hanging-indents 'safe-local-variable | ||
| 757 | (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil))))) | ||
| 758 | |||
| 759 | ;;;_ = allout-reindent-bodies | ||
| 760 | (defcustom allout-reindent-bodies (if allout-use-hanging-indents | ||
| 761 | 'text) | ||
| 762 | "*Non-nil enables auto-adjust of topic body hanging indent with depth shifts. | ||
| 763 | |||
| 764 | When active, topic body lines that are indented even with or beyond | ||
| 765 | their topic header are reindented to correspond with depth shifts of | ||
| 766 | the header. | ||
| 767 | |||
| 768 | A value of t enables reindent in non-programming-code buffers, ie | ||
| 769 | those that do not have the variable `comment-start' set. A value of | ||
| 770 | `force' enables reindent whether or not `comment-start' is set." | ||
| 771 | :type '(choice (const nil) (const t) (const text) (const force)) | ||
| 772 | :group 'allout) | ||
| 773 | |||
| 774 | (make-variable-buffer-local 'allout-reindent-bodies) | ||
| 775 | ;;;###autoload | ||
| 776 | (put 'allout-reindent-bodies 'safe-local-variable | ||
| 777 | '(lambda (x) (memq x '(nil t text force)))) | ||
| 778 | |||
| 779 | ;;;_ = allout-enable-file-variable-adjustment | 777 | ;;;_ = allout-enable-file-variable-adjustment |
| 780 | (defcustom allout-enable-file-variable-adjustment t | 778 | (defcustom allout-enable-file-variable-adjustment t |
| 781 | "*If non-nil, some allout outline actions edit Emacs local file var text. | 779 | "*If non-nil, some allout outline actions edit Emacs local file var text. |
| @@ -906,13 +904,31 @@ This is properly set by `set-allout-regexp'.") | |||
| 906 | (make-variable-buffer-local 'allout-plain-bullets-string-len) | 904 | (make-variable-buffer-local 'allout-plain-bullets-string-len) |
| 907 | 905 | ||
| 908 | ;;;_ = allout-doublecheck-at-and-shallower | 906 | ;;;_ = allout-doublecheck-at-and-shallower |
| 909 | (defconst allout-doublecheck-at-and-shallower 2 | 907 | (defconst allout-doublecheck-at-and-shallower 3 |
| 910 | "Validate apparent topics of this depth and shallower as being non-aberrant. | 908 | "Validate apparent topics of this depth and shallower as being non-aberrant. |
| 911 | 909 | ||
| 912 | Verified with `allout-aberrant-container-p'. This check's usefulness is | 910 | Verified with `allout-aberrant-container-p'. The usefulness of |
| 913 | limited to shallow depths, because the determination of aberrance | 911 | this check is limited to shallow depths, because the |
| 914 | is according to the mistaken item being followed by a legitimate item of | 912 | determination of aberrance is according to the mistaken item |
| 915 | excessively greater depth.") | 913 | being followed by a legitimate item of excessively greater depth. |
| 914 | |||
| 915 | The classic example of a mistaken item, for a standard allout | ||
| 916 | outline configuration, is a body line that begins with an '...' | ||
| 917 | ellipsis. This happens to contain a legitimate depth-2 header | ||
| 918 | prefix, constituted by two '..' dots at the beginning of the | ||
| 919 | line. The only thing that can distinguish it *in principle* from | ||
| 920 | a legitimate one is if the following real header is at a depth | ||
| 921 | that is discontinuous from the depth of 2 implied by the | ||
| 922 | ellipsis, ie depth 4 or more. As the depth being tested gets | ||
| 923 | greater, the likelihood of this kind of disqualification is | ||
| 924 | lower, and the usefulness of this test is lower. | ||
| 925 | |||
| 926 | Extending the depth of the doublecheck increases the amount it is | ||
| 927 | applied, increasing the cost of the test - on casual estimation, | ||
| 928 | for outlines with many deep topics, geometrically (O(n)?). | ||
| 929 | Taken together with decreasing likelihood that the test will be | ||
| 930 | useful at greater depths, more modest doublecheck limits are more | ||
| 931 | suitably economical.") | ||
| 916 | ;;;_ X allout-reset-header-lead (header-lead) | 932 | ;;;_ X allout-reset-header-lead (header-lead) |
| 917 | (defun allout-reset-header-lead (header-lead) | 933 | (defun allout-reset-header-lead (header-lead) |
| 918 | "*Reset the leading string used to identify topic headers." | 934 | "*Reset the leading string used to identify topic headers." |
| @@ -1131,16 +1147,16 @@ See doc string for allout-keybindings-list for format of binding list." | |||
| 1131 | (let ((map (or base-map (make-sparse-keymap))) | 1147 | (let ((map (or base-map (make-sparse-keymap))) |
| 1132 | (pref (list allout-command-prefix))) | 1148 | (pref (list allout-command-prefix))) |
| 1133 | (mapc (function | 1149 | (mapc (function |
| 1134 | (lambda (cell) | 1150 | (lambda (cell) |
| 1135 | (let ((add-pref (null (cdr (cdr cell)))) | 1151 | (let ((add-pref (null (cdr (cdr cell)))) |
| 1136 | (key-suff (list (car cell)))) | 1152 | (key-suff (list (car cell)))) |
| 1137 | (apply 'define-key | 1153 | (apply 'define-key |
| 1138 | (list map | 1154 | (list map |
| 1139 | (apply 'concat (if add-pref | 1155 | (apply 'vconcat (if add-pref |
| 1140 | (append pref key-suff) | 1156 | (append pref key-suff) |
| 1141 | key-suff)) | 1157 | key-suff)) |
| 1142 | (car (cdr cell))))))) | 1158 | (car (cdr cell))))))) |
| 1143 | keymap-list) | 1159 | keymap-list) |
| 1144 | map)) | 1160 | map)) |
| 1145 | ;;;_ : Menu bar | 1161 | ;;;_ : Menu bar |
| 1146 | (defvar allout-mode-exposure-menu) | 1162 | (defvar allout-mode-exposure-menu) |
| @@ -2130,8 +2146,10 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be." | |||
| 2130 | ;;; &optional prelen) | 2146 | ;;; &optional prelen) |
| 2131 | (defun allout-overlay-insert-in-front-handler (ol after beg end | 2147 | (defun allout-overlay-insert-in-front-handler (ol after beg end |
| 2132 | &optional prelen) | 2148 | &optional prelen) |
| 2133 | "Shift the overlay so stuff inserted in front of it are excluded." | 2149 | "Shift the overlay so stuff inserted in front of it is excluded." |
| 2134 | (if after | 2150 | (if after |
| 2151 | ;; XXX Shouldn't moving the overlay should be unnecessary, if overlay | ||
| 2152 | ;; front-advance on the overlay worked as it should? | ||
| 2135 | (move-overlay ol (1+ beg) (overlay-end ol)))) | 2153 | (move-overlay ol (1+ beg) (overlay-end ol)))) |
| 2136 | ;;;_ > allout-overlay-interior-modification-handler (ol after beg end | 2154 | ;;;_ > allout-overlay-interior-modification-handler (ol after beg end |
| 2137 | ;;; &optional prelen) | 2155 | ;;; &optional prelen) |
| @@ -2319,19 +2337,20 @@ exceeds the topic by more than one." | |||
| 2319 | (let ((depth (allout-depth)) | 2337 | (let ((depth (allout-depth)) |
| 2320 | (start-point (point)) | 2338 | (start-point (point)) |
| 2321 | done aberrant) | 2339 | done aberrant) |
| 2322 | (save-excursion | 2340 | (save-match-data |
| 2323 | (while (and (not done) | 2341 | (save-excursion |
| 2324 | (re-search-forward allout-line-boundary-regexp nil 0)) | 2342 | (while (and (not done) |
| 2325 | (allout-prefix-data) | 2343 | (re-search-forward allout-line-boundary-regexp nil 0)) |
| 2326 | (goto-char allout-recent-prefix-beginning) | 2344 | (allout-prefix-data) |
| 2327 | (cond | 2345 | (goto-char allout-recent-prefix-beginning) |
| 2328 | ;; sibling - continue: | 2346 | (cond |
| 2329 | ((eq allout-recent-depth depth)) | 2347 | ;; sibling - continue: |
| 2330 | ;; first offspring is excessive - aberrant: | 2348 | ((eq allout-recent-depth depth)) |
| 2331 | ((> allout-recent-depth (1+ depth)) | 2349 | ;; first offspring is excessive - aberrant: |
| 2332 | (setq done t aberrant t)) | 2350 | ((> allout-recent-depth (1+ depth)) |
| 2333 | ;; next non-sibling is lower-depth - not aberrant: | 2351 | (setq done t aberrant t)) |
| 2334 | (t (setq done t))))) | 2352 | ;; next non-sibling is lower-depth - not aberrant: |
| 2353 | (t (setq done t)))))) | ||
| 2335 | (if aberrant | 2354 | (if aberrant |
| 2336 | aberrant | 2355 | aberrant |
| 2337 | (goto-char start-point) | 2356 | (goto-char start-point) |
| @@ -2345,19 +2364,21 @@ exceeds the topic by more than one." | |||
| 2345 | Actually, returns prefix beginning point." | 2364 | Actually, returns prefix beginning point." |
| 2346 | (save-excursion | 2365 | (save-excursion |
| 2347 | (allout-beginning-of-current-line) | 2366 | (allout-beginning-of-current-line) |
| 2348 | (and (looking-at allout-regexp) | 2367 | (save-match-data |
| 2349 | (allout-prefix-data) | 2368 | (and (looking-at allout-regexp) |
| 2350 | (or (not (allout-do-doublecheck)) | 2369 | (allout-prefix-data) |
| 2351 | (not (allout-aberrant-container-p)))))) | 2370 | (or (not (allout-do-doublecheck)) |
| 2371 | (not (allout-aberrant-container-p))))))) | ||
| 2352 | ;;;_ > allout-on-heading-p () | 2372 | ;;;_ > allout-on-heading-p () |
| 2353 | (defalias 'allout-on-heading-p 'allout-on-current-heading-p) | 2373 | (defalias 'allout-on-heading-p 'allout-on-current-heading-p) |
| 2354 | ;;;_ > allout-e-o-prefix-p () | 2374 | ;;;_ > allout-e-o-prefix-p () |
| 2355 | (defun allout-e-o-prefix-p () | 2375 | (defun allout-e-o-prefix-p () |
| 2356 | "True if point is located where current topic prefix ends, heading begins." | 2376 | "True if point is located where current topic prefix ends, heading begins." |
| 2357 | (and (save-excursion (let ((inhibit-field-text-motion t)) | 2377 | (and (save-match-data |
| 2358 | (beginning-of-line)) | 2378 | (save-excursion (let ((inhibit-field-text-motion t)) |
| 2359 | (looking-at allout-regexp)) | 2379 | (beginning-of-line)) |
| 2360 | (= (point)(save-excursion (allout-end-of-prefix)(point))))) | 2380 | (looking-at allout-regexp)) |
| 2381 | (= (point) (save-excursion (allout-end-of-prefix)(point)))))) | ||
| 2361 | ;;;_ : Location attributes | 2382 | ;;;_ : Location attributes |
| 2362 | ;;;_ > allout-depth () | 2383 | ;;;_ > allout-depth () |
| 2363 | (defun allout-depth () | 2384 | (defun allout-depth () |
| @@ -2485,7 +2506,12 @@ Outermost is first." | |||
| 2485 | 2506 | ||
| 2486 | (if (or (not allout-beginning-of-line-cycles) | 2507 | (if (or (not allout-beginning-of-line-cycles) |
| 2487 | (not (equal last-command this-command))) | 2508 | (not (equal last-command this-command))) |
| 2488 | (move-beginning-of-line 1) | 2509 | (progn |
| 2510 | (if (and (not (bolp)) | ||
| 2511 | (allout-hidden-p (1- (point)))) | ||
| 2512 | (goto-char (previous-single-char-property-change | ||
| 2513 | (1- (point)) 'invisible))) | ||
| 2514 | (move-beginning-of-line 1)) | ||
| 2489 | (allout-depth) | 2515 | (allout-depth) |
| 2490 | (let ((beginning-of-body | 2516 | (let ((beginning-of-body |
| 2491 | (save-excursion | 2517 | (save-excursion |
| @@ -2528,7 +2554,10 @@ Outermost is first." | |||
| 2528 | ((>= (point) end-of-entry) | 2554 | ((>= (point) end-of-entry) |
| 2529 | (allout-back-to-current-heading) | 2555 | (allout-back-to-current-heading) |
| 2530 | (allout-end-of-current-line)) | 2556 | (allout-end-of-current-line)) |
| 2531 | (t (allout-end-of-entry)))))) | 2557 | (t |
| 2558 | (if (not (and transient-mark-mode mark-active)) | ||
| 2559 | (push-mark)) | ||
| 2560 | (allout-end-of-entry)))))) | ||
| 2532 | ;;;_ > allout-next-heading () | 2561 | ;;;_ > allout-next-heading () |
| 2533 | (defsubst allout-next-heading () | 2562 | (defsubst allout-next-heading () |
| 2534 | "Move to the heading for the topic (possibly invisible) after this one. | 2563 | "Move to the heading for the topic (possibly invisible) after this one. |
| @@ -2536,16 +2565,18 @@ Outermost is first." | |||
| 2536 | Returns the location of the heading, or nil if none found. | 2565 | Returns the location of the heading, or nil if none found. |
| 2537 | 2566 | ||
| 2538 | We skip anomolous low-level topics, a la `allout-aberrant-container-p'." | 2567 | We skip anomolous low-level topics, a la `allout-aberrant-container-p'." |
| 2539 | (if (looking-at allout-regexp) | 2568 | (save-match-data |
| 2540 | (forward-char 1)) | 2569 | |
| 2541 | 2570 | (if (looking-at allout-regexp) | |
| 2542 | (when (re-search-forward allout-line-boundary-regexp nil 0) | 2571 | (forward-char 1)) |
| 2543 | (allout-prefix-data) | 2572 | |
| 2544 | (and (allout-do-doublecheck) | 2573 | (when (re-search-forward allout-line-boundary-regexp nil 0) |
| 2545 | ;; this will set allout-recent-* on the first non-aberrant topic, | 2574 | (allout-prefix-data) |
| 2546 | ;; whether it's the current one or one that disqualifies it: | 2575 | (and (allout-do-doublecheck) |
| 2547 | (allout-aberrant-container-p)) | 2576 | ;; this will set allout-recent-* on the first non-aberrant topic, |
| 2548 | (goto-char allout-recent-prefix-beginning))) | 2577 | ;; whether it's the current one or one that disqualifies it: |
| 2578 | (allout-aberrant-container-p)) | ||
| 2579 | (goto-char allout-recent-prefix-beginning)))) | ||
| 2549 | ;;;_ > allout-this-or-next-heading | 2580 | ;;;_ > allout-this-or-next-heading |
| 2550 | (defun allout-this-or-next-heading () | 2581 | (defun allout-this-or-next-heading () |
| 2551 | "Position cursor on current or next heading." | 2582 | "Position cursor on current or next heading." |
| @@ -2565,17 +2596,18 @@ We skip anomolous low-level topics, a la `allout-aberrant-container-p'." | |||
| 2565 | (let ((start-point (point))) | 2596 | (let ((start-point (point))) |
| 2566 | ;; allout-goto-prefix-doublechecked calls us, so we can't use it here. | 2597 | ;; allout-goto-prefix-doublechecked calls us, so we can't use it here. |
| 2567 | (allout-goto-prefix) | 2598 | (allout-goto-prefix) |
| 2568 | (when (or (re-search-backward allout-line-boundary-regexp nil 0) | 2599 | (save-match-data |
| 2569 | (looking-at allout-bob-regexp)) | 2600 | (when (or (re-search-backward allout-line-boundary-regexp nil 0) |
| 2570 | (goto-char (allout-prefix-data)) | 2601 | (looking-at allout-bob-regexp)) |
| 2571 | (if (and (allout-do-doublecheck) | 2602 | (goto-char (allout-prefix-data)) |
| 2572 | (allout-aberrant-container-p)) | 2603 | (if (and (allout-do-doublecheck) |
| 2573 | (or (allout-previous-heading) | 2604 | (allout-aberrant-container-p)) |
| 2574 | (and (goto-char start-point) | 2605 | (or (allout-previous-heading) |
| 2575 | ;; recalibrate allout-recent-*: | 2606 | (and (goto-char start-point) |
| 2576 | (allout-depth) | 2607 | ;; recalibrate allout-recent-*: |
| 2577 | nil)) | 2608 | (allout-depth) |
| 2578 | (point)))))) | 2609 | nil)) |
| 2610 | (point))))))) | ||
| 2579 | ;;;_ > allout-get-invisibility-overlay () | 2611 | ;;;_ > allout-get-invisibility-overlay () |
| 2580 | (defun allout-get-invisibility-overlay () | 2612 | (defun allout-get-invisibility-overlay () |
| 2581 | "Return the overlay at point that dictates allout invisibility." | 2613 | "Return the overlay at point that dictates allout invisibility." |
| @@ -2782,19 +2814,20 @@ Not sensitive to topic visibility. | |||
| 2782 | 2814 | ||
| 2783 | Returns the point at the beginning of the prefix, or nil if none." | 2815 | Returns the point at the beginning of the prefix, or nil if none." |
| 2784 | 2816 | ||
| 2785 | (let (done) | 2817 | (save-match-data |
| 2786 | (while (and (not done) | 2818 | (let (done) |
| 2787 | (search-backward "\n" nil 1)) | 2819 | (while (and (not done) |
| 2788 | (forward-char 1) | 2820 | (search-backward "\n" nil 1)) |
| 2789 | (if (looking-at allout-regexp) | 2821 | (forward-char 1) |
| 2790 | (setq done (allout-prefix-data)) | 2822 | (if (looking-at allout-regexp) |
| 2791 | (forward-char -1))) | 2823 | (setq done (allout-prefix-data)) |
| 2792 | (if (bobp) | 2824 | (forward-char -1))) |
| 2793 | (cond ((looking-at allout-regexp) | 2825 | (if (bobp) |
| 2794 | (allout-prefix-data)) | 2826 | (cond ((looking-at allout-regexp) |
| 2795 | ((allout-next-heading)) | 2827 | (allout-prefix-data)) |
| 2796 | (done)) | 2828 | ((allout-next-heading)) |
| 2797 | done))) | 2829 | (done)) |
| 2830 | done)))) | ||
| 2798 | ;;;_ > allout-goto-prefix-doublechecked () | 2831 | ;;;_ > allout-goto-prefix-doublechecked () |
| 2799 | (defun allout-goto-prefix-doublechecked () | 2832 | (defun allout-goto-prefix-doublechecked () |
| 2800 | "Put point at beginning of immediately containing outline topic. | 2833 | "Put point at beginning of immediately containing outline topic. |
| @@ -2819,10 +2852,11 @@ otherwise skip white space between bullet and ensuing text." | |||
| 2819 | (if (not (allout-goto-prefix-doublechecked)) | 2852 | (if (not (allout-goto-prefix-doublechecked)) |
| 2820 | nil | 2853 | nil |
| 2821 | (goto-char allout-recent-prefix-end) | 2854 | (goto-char allout-recent-prefix-end) |
| 2822 | (if ignore-decorations | 2855 | (save-match-data |
| 2823 | t | 2856 | (if ignore-decorations |
| 2824 | (while (looking-at "[0-9]") (forward-char 1)) | 2857 | t |
| 2825 | (if (and (not (eolp)) (looking-at "\\s-")) (forward-char 1))) | 2858 | (while (looking-at "[0-9]") (forward-char 1)) |
| 2859 | (if (and (not (eolp)) (looking-at "\\s-")) (forward-char 1)))) | ||
| 2826 | ;; Reestablish where we are: | 2860 | ;; Reestablish where we are: |
| 2827 | (allout-current-depth))) | 2861 | (allout-current-depth))) |
| 2828 | ;;;_ > allout-current-bullet-pos () | 2862 | ;;;_ > allout-current-bullet-pos () |
| @@ -3104,10 +3138,11 @@ situation." | |||
| 3104 | found | 3138 | found |
| 3105 | done) | 3139 | done) |
| 3106 | (while (not done) | 3140 | (while (not done) |
| 3107 | (setq found (if backward | 3141 | (setq found (save-match-data |
| 3108 | (re-search-backward expression nil 'to-limit) | 3142 | (if backward |
| 3109 | (forward-char 1) | 3143 | (re-search-backward expression nil 'to-limit) |
| 3110 | (re-search-forward expression nil 'to-limit))) | 3144 | (forward-char 1) |
| 3145 | (re-search-forward expression nil 'to-limit)))) | ||
| 3111 | (if (and found (allout-aberrant-container-p)) | 3146 | (if (and found (allout-aberrant-container-p)) |
| 3112 | (setq found nil)) | 3147 | (setq found nil)) |
| 3113 | (setq done (or found (if backward (bobp) (eobp))))) | 3148 | (setq done (or found (if backward (bobp) (eobp))))) |
| @@ -3184,18 +3219,19 @@ Move to buffer limit in indicated direction if headings are exhausted." | |||
| 3184 | (error nil)) | 3219 | (error nil)) |
| 3185 | (allout-beginning-of-current-line)) | 3220 | (allout-beginning-of-current-line)) |
| 3186 | ;; Deal with apparent header line: | 3221 | ;; Deal with apparent header line: |
| 3187 | (if (not (looking-at allout-regexp)) | 3222 | (save-match-data |
| 3188 | ;; not a header line, keep looking: | 3223 | (if (not (looking-at allout-regexp)) |
| 3189 | t | 3224 | ;; not a header line, keep looking: |
| 3190 | (allout-prefix-data) | ||
| 3191 | (if (and (allout-do-doublecheck) | ||
| 3192 | (allout-aberrant-container-p)) | ||
| 3193 | ;; skip this aberrant prospective header line: | ||
| 3194 | t | 3225 | t |
| 3195 | ;; this prospective headerline qualifies - register: | 3226 | (allout-prefix-data) |
| 3196 | (setq got allout-recent-prefix-beginning) | 3227 | (if (and (allout-do-doublecheck) |
| 3197 | ;; and break the loop: | 3228 | (allout-aberrant-container-p)) |
| 3198 | nil)))) | 3229 | ;; skip this aberrant prospective header line: |
| 3230 | t | ||
| 3231 | ;; this prospective headerline qualifies - register: | ||
| 3232 | (setq got allout-recent-prefix-beginning) | ||
| 3233 | ;; and break the loop: | ||
| 3234 | nil))))) | ||
| 3199 | ;; Register this got, it may be the last: | 3235 | ;; Register this got, it may be the last: |
| 3200 | (if got (setq prev got)) | 3236 | (if got (setq prev got)) |
| 3201 | (setq arg (1- arg))) | 3237 | (setq arg (1- arg))) |
| @@ -3354,7 +3390,7 @@ Returns the qualifying command, if any, else nil." | |||
| 3354 | ;; translate literal membership on list: | 3390 | ;; translate literal membership on list: |
| 3355 | (cadr (assoc key-string allout-keybindings-list))) | 3391 | (cadr (assoc key-string allout-keybindings-list))) |
| 3356 | ;; translate as a keybinding: | 3392 | ;; translate as a keybinding: |
| 3357 | (key-binding (concat allout-command-prefix | 3393 | (key-binding (vconcat allout-command-prefix |
| 3358 | (char-to-string | 3394 | (char-to-string |
| 3359 | (if (and (<= 97 key-num) ; "a" | 3395 | (if (and (<= 97 key-num) ; "a" |
| 3360 | (>= 122 key-num)) ; "z" | 3396 | (>= 122 key-num)) ; "z" |
| @@ -3623,154 +3659,156 @@ Nuances: | |||
| 3623 | from there." | 3659 | from there." |
| 3624 | 3660 | ||
| 3625 | (allout-beginning-of-current-line) | 3661 | (allout-beginning-of-current-line) |
| 3626 | (let* ((inhibit-field-text-motion t) | 3662 | (save-match-data |
| 3627 | (depth (+ (allout-current-depth) relative-depth)) | 3663 | (let* ((inhibit-field-text-motion t) |
| 3628 | (opening-on-blank (if (looking-at "^\$") | 3664 | (depth (+ (allout-current-depth) relative-depth)) |
| 3629 | (not (setq before nil)))) | 3665 | (opening-on-blank (if (looking-at "^\$") |
| 3630 | ;; bunch o vars set while computing ref-topic | 3666 | (not (setq before nil)))) |
| 3631 | opening-numbered | 3667 | ;; bunch o vars set while computing ref-topic |
| 3632 | ref-depth | 3668 | opening-numbered |
| 3633 | ref-bullet | 3669 | ref-depth |
| 3634 | (ref-topic (save-excursion | 3670 | ref-bullet |
| 3635 | (cond ((< relative-depth 0) | 3671 | (ref-topic (save-excursion |
| 3636 | (allout-ascend-to-depth depth)) | 3672 | (cond ((< relative-depth 0) |
| 3637 | ((>= relative-depth 1) nil) | 3673 | (allout-ascend-to-depth depth)) |
| 3638 | (t (allout-back-to-current-heading))) | 3674 | ((>= relative-depth 1) nil) |
| 3639 | (setq ref-depth allout-recent-depth) | 3675 | (t (allout-back-to-current-heading))) |
| 3640 | (setq ref-bullet | 3676 | (setq ref-depth allout-recent-depth) |
| 3641 | (if (> allout-recent-prefix-end 1) | 3677 | (setq ref-bullet |
| 3642 | (allout-recent-bullet) | 3678 | (if (> allout-recent-prefix-end 1) |
| 3643 | "")) | 3679 | (allout-recent-bullet) |
| 3644 | (setq opening-numbered | 3680 | "")) |
| 3645 | (save-excursion | 3681 | (setq opening-numbered |
| 3646 | (and allout-numbered-bullet | 3682 | (save-excursion |
| 3647 | (or (<= relative-depth 0) | 3683 | (and allout-numbered-bullet |
| 3648 | (allout-descend-to-depth depth)) | 3684 | (or (<= relative-depth 0) |
| 3649 | (if (allout-numbered-type-prefix) | 3685 | (allout-descend-to-depth depth)) |
| 3650 | allout-numbered-bullet)))) | 3686 | (if (allout-numbered-type-prefix) |
| 3651 | (point))) | 3687 | allout-numbered-bullet)))) |
| 3652 | dbl-space | 3688 | (point))) |
| 3653 | doing-beginning | 3689 | dbl-space |
| 3654 | start end) | 3690 | doing-beginning |
| 3655 | 3691 | start end) | |
| 3656 | (if (not opening-on-blank) | 3692 | |
| 3693 | (if (not opening-on-blank) | ||
| 3657 | ; Positioning and vertical | 3694 | ; Positioning and vertical |
| 3658 | ; padding - only if not | 3695 | ; padding - only if not |
| 3659 | ; opening-on-blank: | 3696 | ; opening-on-blank: |
| 3660 | (progn | 3697 | (progn |
| 3661 | (goto-char ref-topic) | 3698 | (goto-char ref-topic) |
| 3662 | (setq dbl-space ; Determine double space action: | 3699 | (setq dbl-space ; Determine double space action: |
| 3663 | (or (and (<= relative-depth 0) ; not descending; | 3700 | (or (and (<= relative-depth 0) ; not descending; |
| 3664 | (save-excursion | 3701 | (save-excursion |
| 3665 | ;; at b-o-b or preceded by a blank line? | 3702 | ;; at b-o-b or preceded by a blank line? |
| 3666 | (or (> 0 (forward-line -1)) | 3703 | (or (> 0 (forward-line -1)) |
| 3667 | (looking-at "^\\s-*$") | 3704 | (looking-at "^\\s-*$") |
| 3668 | (bobp))) | 3705 | (bobp))) |
| 3669 | (save-excursion | 3706 | (save-excursion |
| 3670 | ;; succeeded by a blank line? | 3707 | ;; succeeded by a blank line? |
| 3671 | (allout-end-of-current-subtree) | 3708 | (allout-end-of-current-subtree) |
| 3672 | (looking-at "\n\n"))) | 3709 | (looking-at "\n\n"))) |
| 3673 | (and (= ref-depth 1) | 3710 | (and (= ref-depth 1) |
| 3674 | (or before | 3711 | (or before |
| 3675 | (= depth 1) | 3712 | (= depth 1) |
| 3676 | (save-excursion | 3713 | (save-excursion |
| 3677 | ;; Don't already have following | 3714 | ;; Don't already have following |
| 3678 | ;; vertical padding: | 3715 | ;; vertical padding: |
| 3679 | (not (allout-pre-next-prefix))))))) | 3716 | (not (allout-pre-next-prefix))))))) |
| 3680 | 3717 | ||
| 3681 | ;; Position to prior heading, if inserting backwards, and not | 3718 | ;; Position to prior heading, if inserting backwards, and not |
| 3682 | ;; going outwards: | 3719 | ;; going outwards: |
| 3683 | (if (and before (>= relative-depth 0)) | 3720 | (if (and before (>= relative-depth 0)) |
| 3684 | (progn (allout-back-to-current-heading) | 3721 | (progn (allout-back-to-current-heading) |
| 3685 | (setq doing-beginning (bobp)) | 3722 | (setq doing-beginning (bobp)) |
| 3686 | (if (not (bobp)) | 3723 | (if (not (bobp)) |
| 3687 | (allout-previous-heading))) | 3724 | (allout-previous-heading))) |
| 3688 | (if (and before (bobp)) | 3725 | (if (and before (bobp)) |
| 3689 | (open-line 1))) | 3726 | (open-line 1))) |
| 3690 | 3727 | ||
| 3691 | (if (<= relative-depth 0) | 3728 | (if (<= relative-depth 0) |
| 3692 | ;; Not going inwards, don't snug up: | 3729 | ;; Not going inwards, don't snug up: |
| 3693 | (if doing-beginning | 3730 | (if doing-beginning |
| 3694 | (if (not dbl-space) | 3731 | (if (not dbl-space) |
| 3695 | (open-line 1) | 3732 | (open-line 1) |
| 3696 | (open-line 2)) | 3733 | (open-line 2)) |
| 3697 | (if before | 3734 | (if before |
| 3698 | (progn (end-of-line) | 3735 | (progn (end-of-line) |
| 3699 | (allout-pre-next-prefix) | 3736 | (allout-pre-next-prefix) |
| 3700 | (while (and (= ?\n (following-char)) | 3737 | (while (and (= ?\n (following-char)) |
| 3701 | (save-excursion | 3738 | (save-excursion |
| 3702 | (forward-char 1) | 3739 | (forward-char 1) |
| 3703 | (allout-hidden-p))) | 3740 | (allout-hidden-p))) |
| 3704 | (forward-char 1)) | 3741 | (forward-char 1)) |
| 3705 | (if (not (looking-at "^$")) | 3742 | (if (not (looking-at "^$")) |
| 3706 | (open-line 1))) | 3743 | (open-line 1))) |
| 3707 | (allout-end-of-current-subtree) | 3744 | (allout-end-of-current-subtree) |
| 3708 | (if (looking-at "\n\n") (forward-char 1)))) | 3745 | (if (looking-at "\n\n") (forward-char 1)))) |
| 3709 | ;; Going inwards - double-space if first offspring is | 3746 | ;; Going inwards - double-space if first offspring is |
| 3710 | ;; double-spaced, otherwise snug up. | 3747 | ;; double-spaced, otherwise snug up. |
| 3711 | (allout-end-of-entry) | 3748 | (allout-end-of-entry) |
| 3712 | (if (eobp) | 3749 | (if (eobp) |
| 3713 | (newline 1) | 3750 | (newline 1) |
| 3714 | (line-move 1)) | 3751 | (line-move 1)) |
| 3715 | (allout-beginning-of-current-line) | 3752 | (allout-beginning-of-current-line) |
| 3716 | (backward-char 1) | 3753 | (backward-char 1) |
| 3717 | (if (bolp) | 3754 | (if (bolp) |
| 3718 | ;; Blank lines between current header body and next | 3755 | ;; Blank lines between current header body and next |
| 3719 | ;; header - get to last substantive (non-white-space) | 3756 | ;; header - get to last substantive (non-white-space) |
| 3720 | ;; line in body: | 3757 | ;; line in body: |
| 3721 | (progn (setq dbl-space t) | 3758 | (progn (setq dbl-space t) |
| 3722 | (re-search-backward "[^ \t\n]" nil t))) | 3759 | (re-search-backward "[^ \t\n]" nil t))) |
| 3723 | (if (looking-at "\n\n") | 3760 | (if (looking-at "\n\n") |
| 3724 | (setq dbl-space t)) | 3761 | (setq dbl-space t)) |
| 3725 | (if (save-excursion | 3762 | (if (save-excursion |
| 3726 | (allout-next-heading) | 3763 | (allout-next-heading) |
| 3727 | (when (> allout-recent-depth ref-depth) | 3764 | (when (> allout-recent-depth ref-depth) |
| 3728 | ;; This is an offspring. | 3765 | ;; This is an offspring. |
| 3729 | (forward-line -1) | 3766 | (forward-line -1) |
| 3730 | (looking-at "^\\s-*$"))) | 3767 | (looking-at "^\\s-*$"))) |
| 3731 | (progn (forward-line 1) | 3768 | (progn (forward-line 1) |
| 3732 | (open-line 1) | ||
| 3733 | (forward-line 1))) | ||
| 3734 | (allout-end-of-current-line)) | ||
| 3735 | |||
| 3736 | ;;(if doing-beginning (goto-char doing-beginning)) | ||
| 3737 | (if (not (bobp)) | ||
| 3738 | ;; We insert a newline char rather than using open-line to | ||
| 3739 | ;; avoid rear-stickiness inheritence of read-only property. | ||
| 3740 | (progn (if (and (not (> depth ref-depth)) | ||
| 3741 | (not before)) | ||
| 3742 | (open-line 1) | 3769 | (open-line 1) |
| 3743 | (if (and (not dbl-space) (> depth ref-depth)) | 3770 | (forward-line 1))) |
| 3744 | (newline 1) | 3771 | (allout-end-of-current-line)) |
| 3745 | (if dbl-space | 3772 | |
| 3746 | (open-line 1) | 3773 | ;;(if doing-beginning (goto-char doing-beginning)) |
| 3747 | (if (not before) | 3774 | (if (not (bobp)) |
| 3748 | (newline 1))))) | 3775 | ;; We insert a newline char rather than using open-line to |
| 3749 | (if (and dbl-space (not (> relative-depth 0))) | 3776 | ;; avoid rear-stickiness inheritence of read-only property. |
| 3750 | (newline 1)) | 3777 | (progn (if (and (not (> depth ref-depth)) |
| 3751 | (if (and (not (eobp)) | 3778 | (not before)) |
| 3752 | (or (not (bolp)) | 3779 | (open-line 1) |
| 3753 | (and (not (bobp)) | 3780 | (if (and (not dbl-space) (> depth ref-depth)) |
| 3754 | ;; bolp doesnt detect concealed | 3781 | (newline 1) |
| 3755 | ;; trailing newlines, compensate: | 3782 | (if dbl-space |
| 3756 | (save-excursion | 3783 | (open-line 1) |
| 3757 | (forward-char -1) | 3784 | (if (not before) |
| 3758 | (allout-hidden-p))))) | 3785 | (newline 1))))) |
| 3759 | (forward-char 1)))) | 3786 | (if (and dbl-space (not (> relative-depth 0))) |
| 3760 | )) | 3787 | (newline 1)) |
| 3761 | (setq start (point)) | 3788 | (if (and (not (eobp)) |
| 3762 | (insert (concat (allout-make-topic-prefix opening-numbered t depth) | 3789 | (or (not (bolp)) |
| 3763 | " ")) | 3790 | (and (not (bobp)) |
| 3764 | (setq end (1+ (point))) | 3791 | ;; bolp doesnt detect concealed |
| 3765 | 3792 | ;; trailing newlines, compensate: | |
| 3766 | (allout-rebullet-heading (and offer-recent-bullet ref-bullet) | 3793 | (save-excursion |
| 3767 | depth nil nil t) | 3794 | (forward-char -1) |
| 3768 | (if (> relative-depth 0) | 3795 | (allout-hidden-p))))) |
| 3769 | (save-excursion (goto-char ref-topic) | 3796 | (forward-char 1)))) |
| 3770 | (allout-show-children))) | 3797 | )) |
| 3771 | (end-of-line) | 3798 | (setq start (point)) |
| 3799 | (insert (concat (allout-make-topic-prefix opening-numbered t depth) | ||
| 3800 | " ")) | ||
| 3801 | (setq end (1+ (point))) | ||
| 3802 | |||
| 3803 | (allout-rebullet-heading (and offer-recent-bullet ref-bullet) | ||
| 3804 | depth nil nil t) | ||
| 3805 | (if (> relative-depth 0) | ||
| 3806 | (save-excursion (goto-char ref-topic) | ||
| 3807 | (allout-show-children))) | ||
| 3808 | (end-of-line) | ||
| 3772 | 3809 | ||
| 3773 | (run-hook-with-args 'allout-structure-added-hook start end) | 3810 | (run-hook-with-args 'allout-structure-added-hook start end) |
| 3811 | ) | ||
| 3774 | ) | 3812 | ) |
| 3775 | ) | 3813 | ) |
| 3776 | ;;;_ > allout-open-subtopic (arg) | 3814 | ;;;_ > allout-open-subtopic (arg) |
| @@ -3816,14 +3854,15 @@ Maintains outline hanging topic indentation if | |||
| 3816 | (when (not allout-inhibit-auto-fill) | 3854 | (when (not allout-inhibit-auto-fill) |
| 3817 | (let ((fill-prefix (if allout-use-hanging-indents | 3855 | (let ((fill-prefix (if allout-use-hanging-indents |
| 3818 | ;; Check for topic header indentation: | 3856 | ;; Check for topic header indentation: |
| 3819 | (save-excursion | 3857 | (save-match-data |
| 3820 | (beginning-of-line) | 3858 | (save-excursion |
| 3821 | (if (looking-at allout-regexp) | 3859 | (beginning-of-line) |
| 3822 | ;; ... construct indentation to account for | 3860 | (if (looking-at allout-regexp) |
| 3823 | ;; length of topic prefix: | 3861 | ;; ... construct indentation to account for |
| 3824 | (make-string (progn (allout-end-of-prefix) | 3862 | ;; length of topic prefix: |
| 3825 | (current-column)) | 3863 | (make-string (progn (allout-end-of-prefix) |
| 3826 | ?\ ))))) | 3864 | (current-column)) |
| 3865 | ?\ )))))) | ||
| 3827 | (use-auto-fill-function (or allout-outside-normal-auto-fill-function | 3866 | (use-auto-fill-function (or allout-outside-normal-auto-fill-function |
| 3828 | auto-fill-function | 3867 | auto-fill-function |
| 3829 | 'do-auto-fill))) | 3868 | 'do-auto-fill))) |
| @@ -3967,11 +4006,12 @@ this function." | |||
| 3967 | (goto-char mb) | 4006 | (goto-char mb) |
| 3968 | ; Dispense with number if | 4007 | ; Dispense with number if |
| 3969 | ; numbered-bullet prefix: | 4008 | ; numbered-bullet prefix: |
| 3970 | (if (and allout-numbered-bullet | 4009 | (save-match-data |
| 3971 | (string= allout-numbered-bullet current-bullet) | 4010 | (if (and allout-numbered-bullet |
| 3972 | (looking-at "[0-9]+")) | 4011 | (string= allout-numbered-bullet current-bullet) |
| 3973 | (allout-unprotected | 4012 | (looking-at "[0-9]+")) |
| 3974 | (delete-region (match-beginning 0)(match-end 0)))) | 4013 | (allout-unprotected |
| 4014 | (delete-region (match-beginning 0)(match-end 0))))) | ||
| 3975 | 4015 | ||
| 3976 | ;; convey 'allout-was-hidden annotation, if original had it: | 4016 | ;; convey 'allout-was-hidden annotation, if original had it: |
| 3977 | (if has-annotation | 4017 | (if has-annotation |
| @@ -4297,7 +4337,7 @@ subtopics into siblings of the item." | |||
| 4297 | 4337 | ||
| 4298 | (if (or (not (allout-mode-p)) | 4338 | (if (or (not (allout-mode-p)) |
| 4299 | (not (bolp)) | 4339 | (not (bolp)) |
| 4300 | (not (looking-at allout-regexp))) | 4340 | (not (save-match-data (looking-at allout-regexp)))) |
| 4301 | ;; Just do a regular kill: | 4341 | ;; Just do a regular kill: |
| 4302 | (kill-line arg) | 4342 | (kill-line arg) |
| 4303 | ;; Ah, have to watch out for adjustments: | 4343 | ;; Ah, have to watch out for adjustments: |
| @@ -4317,7 +4357,7 @@ subtopics into siblings of the item." | |||
| 4317 | 4357 | ||
| 4318 | (if allout-numbered-bullet | 4358 | (if allout-numbered-bullet |
| 4319 | (save-excursion ; Renumber subsequent topics if needed: | 4359 | (save-excursion ; Renumber subsequent topics if needed: |
| 4320 | (if (not (looking-at allout-regexp)) | 4360 | (if (not (save-match-data (looking-at allout-regexp))) |
| 4321 | (allout-next-heading)) | 4361 | (allout-next-heading)) |
| 4322 | (allout-renumber-to-depth depth))) | 4362 | (allout-renumber-to-depth depth))) |
| 4323 | (run-hook-with-args 'allout-structure-deleted-hook depth (point))))) | 4363 | (run-hook-with-args 'allout-structure-deleted-hook depth (point))))) |
| @@ -4352,7 +4392,7 @@ allout-yank-processing for exposure recovery." | |||
| 4352 | (if (and (/= (current-column) 0) (not (eobp))) | 4392 | (if (and (/= (current-column) 0) (not (eobp))) |
| 4353 | (forward-char 1)) | 4393 | (forward-char 1)) |
| 4354 | (if (not (eobp)) | 4394 | (if (not (eobp)) |
| 4355 | (if (and (looking-at "\n") | 4395 | (if (and (save-match-data (looking-at "\n")) |
| 4356 | (or (save-excursion | 4396 | (or (save-excursion |
| 4357 | (or (not (allout-next-heading)) | 4397 | (or (not (allout-next-heading)) |
| 4358 | (= depth allout-recent-depth))) | 4398 | (= depth allout-recent-depth))) |
| @@ -4449,7 +4489,7 @@ allout-yank-processing for exposure recovery." | |||
| 4449 | (setq next (next-single-char-property-change (point) | 4489 | (setq next (next-single-char-property-change (point) |
| 4450 | 'allout-was-hidden | 4490 | 'allout-was-hidden |
| 4451 | nil end)) | 4491 | nil end)) |
| 4452 | (overlay-put (make-overlay prev next) | 4492 | (overlay-put (make-overlay prev next nil 'front-advance) |
| 4453 | 'category 'allout-exposure-category) | 4493 | 'category 'allout-exposure-category) |
| 4454 | (allout-deannotate-hidden prev next) | 4494 | (allout-deannotate-hidden prev next) |
| 4455 | (setq prev next) | 4495 | (setq prev next) |
| @@ -4481,117 +4521,120 @@ however, are left exactly like normal, non-allout-specific yanks." | |||
| 4481 | ; region around subject: | 4521 | ; region around subject: |
| 4482 | (if (< (allout-mark-marker t) (point)) | 4522 | (if (< (allout-mark-marker t) (point)) |
| 4483 | (exchange-point-and-mark)) | 4523 | (exchange-point-and-mark)) |
| 4484 | (let* ((subj-beg (point)) | 4524 | (save-match-data |
| 4485 | (into-bol (bolp)) | 4525 | (let* ((subj-beg (point)) |
| 4486 | (subj-end (allout-mark-marker t)) | 4526 | (into-bol (bolp)) |
| 4487 | ;; 'resituate' if yanking an entire topic into topic header: | 4527 | (subj-end (allout-mark-marker t)) |
| 4488 | (resituate (and (let ((allout-inhibit-aberrance-doublecheck t)) | 4528 | ;; 'resituate' if yanking an entire topic into topic header: |
| 4489 | (allout-e-o-prefix-p)) | 4529 | (resituate (and (let ((allout-inhibit-aberrance-doublecheck t)) |
| 4490 | (looking-at allout-regexp) | 4530 | (allout-e-o-prefix-p)) |
| 4491 | (allout-prefix-data))) | 4531 | (looking-at allout-regexp) |
| 4492 | ;; `rectify-numbering' if resituating (where several topics may | 4532 | (allout-prefix-data))) |
| 4493 | ;; be resituating) or yanking a topic into a topic slot (bol): | 4533 | ;; `rectify-numbering' if resituating (where several topics may |
| 4494 | (rectify-numbering (or resituate | 4534 | ;; be resituating) or yanking a topic into a topic slot (bol): |
| 4495 | (and into-bol (looking-at allout-regexp))))) | 4535 | (rectify-numbering (or resituate |
| 4496 | (if resituate | 4536 | (and into-bol |
| 4497 | ;; Yanking a topic into the start of a topic - reconcile to fit: | 4537 | (looking-at allout-regexp))))) |
| 4498 | (let* ((inhibit-field-text-motion t) | 4538 | (if resituate |
| 4499 | (prefix-len (if (not (match-end 1)) | 4539 | ;; Yanking a topic into the start of a topic - reconcile to fit: |
| 4500 | 1 | 4540 | (let* ((inhibit-field-text-motion t) |
| 4501 | (- (match-end 1) subj-beg))) | 4541 | (prefix-len (if (not (match-end 1)) |
| 4502 | (subj-depth allout-recent-depth) | 4542 | 1 |
| 4503 | (prefix-bullet (allout-recent-bullet)) | 4543 | (- (match-end 1) subj-beg))) |
| 4504 | (adjust-to-depth | 4544 | (subj-depth allout-recent-depth) |
| 4505 | ;; Nil if adjustment unnecessary, otherwise depth to which | 4545 | (prefix-bullet (allout-recent-bullet)) |
| 4506 | ;; adjustment should be made: | 4546 | (adjust-to-depth |
| 4507 | (save-excursion | 4547 | ;; Nil if adjustment unnecessary, otherwise depth to which |
| 4508 | (and (goto-char subj-end) | 4548 | ;; adjustment should be made: |
| 4509 | (eolp) | 4549 | (save-excursion |
| 4510 | (goto-char subj-beg) | 4550 | (and (goto-char subj-end) |
| 4511 | (and (looking-at allout-regexp) | 4551 | (eolp) |
| 4512 | (progn | 4552 | (goto-char subj-beg) |
| 4513 | (beginning-of-line) | 4553 | (and (looking-at allout-regexp) |
| 4514 | (not (= (point) subj-beg))) | 4554 | (progn |
| 4515 | (looking-at allout-regexp) | 4555 | (beginning-of-line) |
| 4516 | (allout-prefix-data)) | 4556 | (not (= (point) subj-beg))) |
| 4517 | allout-recent-depth))) | 4557 | (looking-at allout-regexp) |
| 4518 | (more t)) | 4558 | (allout-prefix-data)) |
| 4519 | (setq rectify-numbering allout-numbered-bullet) | 4559 | allout-recent-depth))) |
| 4520 | (if adjust-to-depth | 4560 | (more t)) |
| 4561 | (setq rectify-numbering allout-numbered-bullet) | ||
| 4562 | (if adjust-to-depth | ||
| 4521 | ; Do the adjustment: | 4563 | ; Do the adjustment: |
| 4522 | (progn | 4564 | (progn |
| 4523 | (save-restriction | 4565 | (save-restriction |
| 4524 | (narrow-to-region subj-beg subj-end) | 4566 | (narrow-to-region subj-beg subj-end) |
| 4525 | ; Trim off excessive blank | 4567 | ; Trim off excessive blank |
| 4526 | ; line at end, if any: | 4568 | ; line at end, if any: |
| 4527 | (goto-char (point-max)) | 4569 | (goto-char (point-max)) |
| 4528 | (if (looking-at "^$") | 4570 | (if (looking-at "^$") |
| 4529 | (allout-unprotected (delete-char -1))) | 4571 | (allout-unprotected (delete-char -1))) |
| 4530 | ; Work backwards, with each | 4572 | ; Work backwards, with each |
| 4531 | ; shallowest level, | 4573 | ; shallowest level, |
| 4532 | ; successively excluding the | 4574 | ; successively excluding the |
| 4533 | ; last processed topic from | 4575 | ; last processed topic from |
| 4534 | ; the narrow region: | 4576 | ; the narrow region: |
| 4535 | (while more | 4577 | (while more |
| 4536 | (allout-back-to-current-heading) | 4578 | (allout-back-to-current-heading) |
| 4537 | ; go as high as we can in each bunch: | 4579 | ; go as high as we can in each bunch: |
| 4538 | (while (allout-ascend t)) | 4580 | (while (allout-ascend t)) |
| 4539 | (save-excursion | 4581 | (save-excursion |
| 4540 | (allout-unprotected | 4582 | (allout-unprotected |
| 4541 | (allout-rebullet-topic-grunt (- adjust-to-depth | 4583 | (allout-rebullet-topic-grunt (- adjust-to-depth |
| 4542 | subj-depth))) | 4584 | subj-depth))) |
| 4543 | (allout-depth)) | 4585 | (allout-depth)) |
| 4544 | (if (setq more (not (bobp))) | 4586 | (if (setq more (not (bobp))) |
| 4545 | (progn (widen) | 4587 | (progn (widen) |
| 4546 | (forward-char -1) | 4588 | (forward-char -1) |
| 4547 | (narrow-to-region subj-beg (point)))))) | 4589 | (narrow-to-region subj-beg (point)))))) |
| 4548 | ;; Preserve new bullet if it's a distinctive one, otherwise | 4590 | ;; Preserve new bullet if it's a distinctive one, otherwise |
| 4549 | ;; use old one: | 4591 | ;; use old one: |
| 4550 | (if (string-match (regexp-quote prefix-bullet) | 4592 | (if (string-match (regexp-quote prefix-bullet) |
| 4551 | allout-distinctive-bullets-string) | 4593 | allout-distinctive-bullets-string) |
| 4552 | ; Delete from bullet of old to | 4594 | ; Delete from bullet of old to |
| 4553 | ; before bullet of new: | 4595 | ; before bullet of new: |
| 4554 | (progn | 4596 | (progn |
| 4555 | (beginning-of-line) | 4597 | (beginning-of-line) |
| 4556 | (allout-unprotected | 4598 | (allout-unprotected |
| 4557 | (delete-region (point) subj-beg)) | 4599 | (delete-region (point) subj-beg)) |
| 4558 | (set-marker (allout-mark-marker t) subj-end) | 4600 | (set-marker (allout-mark-marker t) subj-end) |
| 4559 | (goto-char subj-beg) | 4601 | (goto-char subj-beg) |
| 4560 | (allout-end-of-prefix)) | 4602 | (allout-end-of-prefix)) |
| 4561 | ; Delete base subj prefix, | 4603 | ; Delete base subj prefix, |
| 4562 | ; leaving old one: | 4604 | ; leaving old one: |
| 4563 | (allout-unprotected | 4605 | (allout-unprotected |
| 4564 | (progn | 4606 | (progn |
| 4565 | (delete-region (point) (+ (point) | 4607 | (delete-region (point) (+ (point) |
| 4566 | prefix-len | 4608 | prefix-len |
| 4567 | (- adjust-to-depth | 4609 | (- adjust-to-depth |
| 4568 | subj-depth))) | 4610 | subj-depth))) |
| 4569 | ; and delete residual subj | 4611 | ; and delete residual subj |
| 4570 | ; prefix digits and space: | 4612 | ; prefix digits and space: |
| 4571 | (while (looking-at "[0-9]") (delete-char 1)) | 4613 | (while (looking-at "[0-9]") (delete-char 1)) |
| 4572 | (if (looking-at " ") (delete-char 1)))))) | 4614 | (if (looking-at " ") |
| 4573 | (exchange-point-and-mark)))) | 4615 | (delete-char 1)))))) |
| 4574 | (if rectify-numbering | 4616 | (exchange-point-and-mark)))) |
| 4575 | (progn | 4617 | (if rectify-numbering |
| 4576 | (save-excursion | 4618 | (progn |
| 4619 | (save-excursion | ||
| 4577 | ; Give some preliminary feedback: | 4620 | ; Give some preliminary feedback: |
| 4578 | (message "... reconciling numbers") | 4621 | (message "... reconciling numbers") |
| 4579 | ; ... and renumber, in case necessary: | 4622 | ; ... and renumber, in case necessary: |
| 4580 | (goto-char subj-beg) | 4623 | (goto-char subj-beg) |
| 4581 | (if (allout-goto-prefix-doublechecked) | 4624 | (if (allout-goto-prefix-doublechecked) |
| 4582 | (allout-unprotected | 4625 | (allout-unprotected |
| 4583 | (allout-rebullet-heading nil ;;; solicit | 4626 | (allout-rebullet-heading nil ;;; solicit |
| 4584 | (allout-depth) ;;; depth | 4627 | (allout-depth) ;;; depth |
| 4585 | nil ;;; number-control | 4628 | nil ;;; number-control |
| 4586 | nil ;;; index | 4629 | nil ;;; index |
| 4587 | t))) | 4630 | t))) |
| 4588 | (message "")))) | 4631 | (message "")))) |
| 4589 | (if (or into-bol resituate) | 4632 | (if (or into-bol resituate) |
| 4590 | (allout-hide-by-annotation (point) (allout-mark-marker t)) | 4633 | (allout-hide-by-annotation (point) (allout-mark-marker t)) |
| 4591 | (allout-deannotate-hidden (allout-mark-marker t) (point))) | 4634 | (allout-deannotate-hidden (allout-mark-marker t) (point))) |
| 4592 | (if (not resituate) | 4635 | (if (not resituate) |
| 4593 | (exchange-point-and-mark)) | 4636 | (exchange-point-and-mark)) |
| 4594 | (run-hook-with-args 'allout-structure-added-hook subj-beg subj-end))) | 4637 | (run-hook-with-args 'allout-structure-added-hook subj-beg subj-end)))) |
| 4595 | ;;;_ > allout-yank (&optional arg) | 4638 | ;;;_ > allout-yank (&optional arg) |
| 4596 | (defun allout-yank (&optional arg) | 4639 | (defun allout-yank (&optional arg) |
| 4597 | "`allout-mode' yank, with depth and numbering adjustment of yanked topics. | 4640 | "`allout-mode' yank, with depth and numbering adjustment of yanked topics. |
| @@ -4658,13 +4701,15 @@ by pops to non-distinctive yanks. Bug..." | |||
| 4658 | allout-file-xref-bullet) | 4701 | allout-file-xref-bullet) |
| 4659 | (let ((inhibit-field-text-motion t) | 4702 | (let ((inhibit-field-text-motion t) |
| 4660 | file-name) | 4703 | file-name) |
| 4661 | (save-excursion | 4704 | (save-match-data |
| 4662 | (let* ((text-start allout-recent-prefix-end) | 4705 | (save-excursion |
| 4663 | (heading-end (progn (end-of-line) (point)))) | 4706 | (let* ((text-start allout-recent-prefix-end) |
| 4664 | (goto-char text-start) | 4707 | (heading-end (progn (end-of-line) (point)))) |
| 4665 | (setq file-name | 4708 | (goto-char text-start) |
| 4666 | (if (re-search-forward "\\s-\\(\\S-*\\)" heading-end t) | 4709 | (setq file-name |
| 4667 | (buffer-substring (match-beginning 1) (match-end 1)))))) | 4710 | (if (re-search-forward "\\s-\\(\\S-*\\)" heading-end t) |
| 4711 | (buffer-substring (match-beginning 1) | ||
| 4712 | (match-end 1))))))) | ||
| 4668 | (setq file-name (expand-file-name file-name)) | 4713 | (setq file-name (expand-file-name file-name)) |
| 4669 | (if (or (file-exists-p file-name) | 4714 | (if (or (file-exists-p file-name) |
| 4670 | (if (file-writable-p file-name) | 4715 | (if (file-writable-p file-name) |
| @@ -4695,7 +4740,7 @@ invoked.)" | |||
| 4695 | ;; We use outline invisibility spec. | 4740 | ;; We use outline invisibility spec. |
| 4696 | (remove-overlays from to 'category 'allout-exposure-category) | 4741 | (remove-overlays from to 'category 'allout-exposure-category) |
| 4697 | (when flag | 4742 | (when flag |
| 4698 | (let ((o (make-overlay from to))) | 4743 | (let ((o (make-overlay from to nil 'front-advance))) |
| 4699 | (overlay-put o 'category 'allout-exposure-category) | 4744 | (overlay-put o 'category 'allout-exposure-category) |
| 4700 | (when (featurep 'xemacs) | 4745 | (when (featurep 'xemacs) |
| 4701 | (let ((props (symbol-plist 'allout-exposure-category))) | 4746 | (let ((props (symbol-plist 'allout-exposure-category))) |
| @@ -4898,16 +4943,17 @@ Single line topics intrinsically can be considered as being both | |||
| 4898 | collapsed and uncollapsed. If optional INCLUDE-SINGLE-LINERS is | 4943 | collapsed and uncollapsed. If optional INCLUDE-SINGLE-LINERS is |
| 4899 | true, then single-line topics are considered to be collapsed. By | 4944 | true, then single-line topics are considered to be collapsed. By |
| 4900 | default, they are treated as being uncollapsed." | 4945 | default, they are treated as being uncollapsed." |
| 4901 | (save-excursion | 4946 | (save-match-data |
| 4902 | (and | 4947 | (save-excursion |
| 4903 | ;; Is the topic all on one line (allowing for trailing blank line)? | 4948 | (and |
| 4904 | (>= (progn (allout-back-to-current-heading) | 4949 | ;; Is the topic all on one line (allowing for trailing blank line)? |
| 4905 | (move-end-of-line 1) | 4950 | (>= (progn (allout-back-to-current-heading) |
| 4906 | (point)) | 4951 | (move-end-of-line 1) |
| 4907 | (allout-end-of-current-subtree (not (looking-at "\n\n")))) | 4952 | (point)) |
| 4908 | 4953 | (allout-end-of-current-subtree (not (looking-at "\n\n")))) | |
| 4909 | (or include-single-liners | 4954 | |
| 4910 | (progn (backward-char 1) (allout-hidden-p)))))) | 4955 | (or include-single-liners |
| 4956 | (progn (backward-char 1) (allout-hidden-p))))))) | ||
| 4911 | ;;;_ > allout-hide-current-subtree (&optional just-close) | 4957 | ;;;_ > allout-hide-current-subtree (&optional just-close) |
| 4912 | (defun allout-hide-current-subtree (&optional just-close) | 4958 | (defun allout-hide-current-subtree (&optional just-close) |
| 4913 | "Close the current topic, or containing topic if this one is already closed. | 4959 | "Close the current topic, or containing topic if this one is already closed. |
| @@ -4931,6 +4977,16 @@ siblings, even if the target topic is already closed." | |||
| 4931 | (allout-expose-topic '(0 :)) | 4977 | (allout-expose-topic '(0 :)) |
| 4932 | (message (concat sibs-msg " Done.")))) | 4978 | (message (concat sibs-msg " Done.")))) |
| 4933 | (goto-char from))) | 4979 | (goto-char from))) |
| 4980 | ;;;_ > allout-toggle-current-subtree-exposure | ||
| 4981 | (defun allout-toggle-current-subtree-exposure () | ||
| 4982 | "Show or hide the current subtree depending on its current state." | ||
| 4983 | ;; thanks to tassilo for suggesting this. | ||
| 4984 | (interactive) | ||
| 4985 | (save-excursion | ||
| 4986 | (allout-back-to-heading) | ||
| 4987 | (if (allout-hidden-p (point-at-eol)) | ||
| 4988 | (allout-show-current-subtree) | ||
| 4989 | (allout-hide-current-subtree)))) | ||
| 4934 | ;;;_ > allout-show-current-branches () | 4990 | ;;;_ > allout-show-current-branches () |
| 4935 | (defun allout-show-current-branches () | 4991 | (defun allout-show-current-branches () |
| 4936 | "Show all subheadings of this heading, but not their bodies." | 4992 | "Show all subheadings of this heading, but not their bodies." |
| @@ -4962,18 +5018,19 @@ siblings, even if the target topic is already closed." | |||
| 4962 | ;;;_ > allout-hide-region-body (start end) | 5018 | ;;;_ > allout-hide-region-body (start end) |
| 4963 | (defun allout-hide-region-body (start end) | 5019 | (defun allout-hide-region-body (start end) |
| 4964 | "Hide all body lines in the region, but not headings." | 5020 | "Hide all body lines in the region, but not headings." |
| 4965 | (save-excursion | 5021 | (save-match-data |
| 4966 | (save-restriction | 5022 | (save-excursion |
| 4967 | (narrow-to-region start end) | 5023 | (save-restriction |
| 4968 | (goto-char (point-min)) | 5024 | (narrow-to-region start end) |
| 4969 | (let ((inhibit-field-text-motion t)) | 5025 | (goto-char (point-min)) |
| 4970 | (while (not (eobp)) | 5026 | (let ((inhibit-field-text-motion t)) |
| 4971 | (end-of-line) | 5027 | (while (not (eobp)) |
| 4972 | (allout-flag-region (point) (allout-end-of-entry) t) | 5028 | (end-of-line) |
| 4973 | (if (not (eobp)) | 5029 | (allout-flag-region (point) (allout-end-of-entry) t) |
| 4974 | (forward-char | 5030 | (if (not (eobp)) |
| 4975 | (if (looking-at "\n\n") | 5031 | (forward-char |
| 4976 | 2 1)))))))) | 5032 | (if (looking-at "\n\n") |
| 5033 | 2 1))))))))) | ||
| 4977 | 5034 | ||
| 4978 | ;;;_ > allout-expose-topic (spec) | 5035 | ;;;_ > allout-expose-topic (spec) |
| 4979 | (defun allout-expose-topic (spec) | 5036 | (defun allout-expose-topic (spec) |
| @@ -5596,14 +5653,15 @@ environment. Leaves point at the end of the line." | |||
| 5596 | (let ((beg (point)) | 5653 | (let ((beg (point)) |
| 5597 | (end (progn (end-of-line)(point)))) | 5654 | (end (progn (end-of-line)(point)))) |
| 5598 | (goto-char beg) | 5655 | (goto-char beg) |
| 5599 | (while (re-search-forward "\\\\" | 5656 | (save-match-data |
| 5600 | ;;"\\\\\\|\\{\\|\\}\\|\\_\\|\\$\\|\\\"\\|\\&\\|\\^\\|\\-\\|\\*\\|#" | 5657 | (while (re-search-forward "\\\\" |
| 5601 | end ; bounded by end-of-line | 5658 | ;;"\\\\\\|\\{\\|\\}\\|\\_\\|\\$\\|\\\"\\|\\&\\|\\^\\|\\-\\|\\*\\|#" |
| 5602 | 1) ; no matches, move to end & return nil | 5659 | end ; bounded by end-of-line |
| 5603 | (goto-char (match-beginning 2)) | 5660 | 1) ; no matches, move to end & return nil |
| 5604 | (insert "\\") | 5661 | (goto-char (match-beginning 2)) |
| 5605 | (setq end (1+ end)) | 5662 | (insert "\\") |
| 5606 | (goto-char (1+ (match-end 2))))))) | 5663 | (setq end (1+ end)) |
| 5664 | (goto-char (1+ (match-end 2)))))))) | ||
| 5607 | ;;;_ > allout-insert-latex-header (buffer) | 5665 | ;;;_ > allout-insert-latex-header (buffer) |
| 5608 | (defun allout-insert-latex-header (buffer) | 5666 | (defun allout-insert-latex-header (buffer) |
| 5609 | "Insert initial LaTeX commands at point in BUFFER." | 5667 | "Insert initial LaTeX commands at point in BUFFER." |
| @@ -6050,8 +6108,9 @@ Returns the resulting string, or nil if the transformation fails." | |||
| 6050 | (let ((re (if (listp re) (car re) re)) | 6108 | (let ((re (if (listp re) (car re) re)) |
| 6051 | (replacement (if (listp re) (cadr re) ""))) | 6109 | (replacement (if (listp re) (cadr re) ""))) |
| 6052 | (goto-char (point-min)) | 6110 | (goto-char (point-min)) |
| 6053 | (while (re-search-forward re nil t) | 6111 | (save-match-data |
| 6054 | (replace-match replacement nil nil))))) | 6112 | (while (re-search-forward re nil t) |
| 6113 | (replace-match replacement nil nil)))))) | ||
| 6055 | 6114 | ||
| 6056 | (cond | 6115 | (cond |
| 6057 | 6116 | ||
| @@ -6282,7 +6341,7 @@ of the availability of a cached copy." | |||
| 6282 | (allout-end-of-prefix t) | 6341 | (allout-end-of-prefix t) |
| 6283 | (and (string= (buffer-substring-no-properties (1- (point)) (point)) | 6342 | (and (string= (buffer-substring-no-properties (1- (point)) (point)) |
| 6284 | allout-topic-encryption-bullet) | 6343 | allout-topic-encryption-bullet) |
| 6285 | (looking-at "\\*")) | 6344 | (save-match-data (looking-at "\\*"))) |
| 6286 | ) | 6345 | ) |
| 6287 | ) | 6346 | ) |
| 6288 | ;;;_ > allout-encrypted-key-info (text) | 6347 | ;;;_ > allout-encrypted-key-info (text) |
| @@ -6420,47 +6479,49 @@ Such a topic has the allout-topic-encryption-bullet without an | |||
| 6420 | immediately following '*' that would mark the topic as being encrypted. It | 6479 | immediately following '*' that would mark the topic as being encrypted. It |
| 6421 | must also have content." | 6480 | must also have content." |
| 6422 | (let (done got content-beg) | 6481 | (let (done got content-beg) |
| 6423 | (while (not done) | 6482 | (save-match-data |
| 6424 | 6483 | (while (not done) | |
| 6425 | (if (not (re-search-forward | ||
| 6426 | (format "\\(\\`\\|\n\\)%s *%s[^*]" | ||
| 6427 | (regexp-quote allout-header-prefix) | ||
| 6428 | (regexp-quote allout-topic-encryption-bullet)) | ||
| 6429 | nil t)) | ||
| 6430 | (setq got nil | ||
| 6431 | done t) | ||
| 6432 | (goto-char (setq got (match-beginning 0))) | ||
| 6433 | (if (looking-at "\n") | ||
| 6434 | (forward-char 1)) | ||
| 6435 | (setq got (point))) | ||
| 6436 | |||
| 6437 | (cond ((not got) | ||
| 6438 | (setq done t)) | ||
| 6439 | |||
| 6440 | ((not (search-forward "\n")) | ||
| 6441 | (setq got nil | ||
| 6442 | done t)) | ||
| 6443 | |||
| 6444 | ((eobp) | ||
| 6445 | (setq got nil | ||
| 6446 | done t)) | ||
| 6447 | 6484 | ||
| 6448 | (t | 6485 | (if (not (re-search-forward |
| 6449 | (setq content-beg (point)) | 6486 | (format "\\(\\`\\|\n\\)%s *%s[^*]" |
| 6450 | (backward-char 1) | 6487 | (regexp-quote allout-header-prefix) |
| 6451 | (allout-end-of-subtree) | 6488 | (regexp-quote allout-topic-encryption-bullet)) |
| 6452 | (if (or (<= (point) content-beg) | 6489 | nil t)) |
| 6453 | (and except-mark | 6490 | (setq got nil |
| 6454 | (<= content-beg except-mark) | 6491 | done t) |
| 6455 | (>= (point) except-mark))) | 6492 | (goto-char (setq got (match-beginning 0))) |
| 6456 | ;; Continue looking | 6493 | (if (save-match-data (looking-at "\n")) |
| 6457 | (setq got nil) | 6494 | (forward-char 1)) |
| 6458 | ;; Got it! | 6495 | (setq got (point))) |
| 6459 | (setq done t))) | 6496 | |
| 6460 | ) | 6497 | (cond ((not got) |
| 6498 | (setq done t)) | ||
| 6499 | |||
| 6500 | ((not (search-forward "\n")) | ||
| 6501 | (setq got nil | ||
| 6502 | done t)) | ||
| 6503 | |||
| 6504 | ((eobp) | ||
| 6505 | (setq got nil | ||
| 6506 | done t)) | ||
| 6507 | |||
| 6508 | (t | ||
| 6509 | (setq content-beg (point)) | ||
| 6510 | (backward-char 1) | ||
| 6511 | (allout-end-of-subtree) | ||
| 6512 | (if (or (<= (point) content-beg) | ||
| 6513 | (and except-mark | ||
| 6514 | (<= content-beg except-mark) | ||
| 6515 | (>= (point) except-mark))) | ||
| 6516 | ;; Continue looking | ||
| 6517 | (setq got nil) | ||
| 6518 | ;; Got it! | ||
| 6519 | (setq done t))) | ||
| 6520 | ) | ||
| 6521 | ) | ||
| 6522 | (if got | ||
| 6523 | (goto-char got)) | ||
| 6461 | ) | 6524 | ) |
| 6462 | (if got | ||
| 6463 | (goto-char got)) | ||
| 6464 | ) | 6525 | ) |
| 6465 | ) | 6526 | ) |
| 6466 | ;;;_ > allout-encrypt-decrypted (&optional except-mark) | 6527 | ;;;_ > allout-encrypt-decrypted (&optional except-mark) |
| @@ -6478,36 +6539,38 @@ and exactly resituate the cursor if this is being done as part of a file | |||
| 6478 | save. See `allout-encrypt-unencrypted-on-saves' for more info." | 6539 | save. See `allout-encrypt-unencrypted-on-saves' for more info." |
| 6479 | 6540 | ||
| 6480 | (interactive "p") | 6541 | (interactive "p") |
| 6481 | (save-excursion | 6542 | (save-match-data |
| 6482 | (let* ((current-mark (point-marker)) | 6543 | (save-excursion |
| 6483 | (current-mark-position (marker-position current-mark)) | 6544 | (let* ((current-mark (point-marker)) |
| 6484 | was-modified | 6545 | (current-mark-position (marker-position current-mark)) |
| 6485 | bo-subtree | 6546 | was-modified |
| 6486 | editing-topic editing-point) | 6547 | bo-subtree |
| 6487 | (goto-char (point-min)) | 6548 | editing-topic editing-point) |
| 6488 | (while (allout-next-topic-pending-encryption except-mark) | 6549 | (goto-char (point-min)) |
| 6489 | (setq was-modified (buffer-modified-p)) | 6550 | (while (allout-next-topic-pending-encryption except-mark) |
| 6490 | (when (save-excursion | 6551 | (setq was-modified (buffer-modified-p)) |
| 6491 | (and (boundp 'allout-encrypt-unencrypted-on-saves) | 6552 | (when (save-excursion |
| 6492 | allout-encrypt-unencrypted-on-saves | 6553 | (and (boundp 'allout-encrypt-unencrypted-on-saves) |
| 6493 | (setq bo-subtree (re-search-forward "$")) | 6554 | allout-encrypt-unencrypted-on-saves |
| 6494 | (not (allout-hidden-p)) | 6555 | (setq bo-subtree (re-search-forward "$")) |
| 6495 | (>= current-mark (point)) | 6556 | (not (allout-hidden-p)) |
| 6496 | (allout-end-of-current-subtree) | 6557 | (>= current-mark (point)) |
| 6497 | (<= current-mark (point)))) | 6558 | (allout-end-of-current-subtree) |
| 6559 | (<= current-mark (point)))) | ||
| 6498 | (setq editing-topic (point) | 6560 | (setq editing-topic (point) |
| 6499 | ;; we had to wait for this 'til now so prior topics are | 6561 | ;; we had to wait for this 'til now so prior topics are |
| 6500 | ;; encrypted, any relevant text shifts are in place: | 6562 | ;; encrypted, any relevant text shifts are in place: |
| 6501 | editing-point (- current-mark-position | 6563 | editing-point (- current-mark-position |
| 6502 | (count-trailing-whitespace-region | 6564 | (count-trailing-whitespace-region |
| 6503 | bo-subtree current-mark-position)))) | 6565 | bo-subtree current-mark-position)))) |
| 6504 | (allout-toggle-subtree-encryption) | 6566 | (allout-toggle-subtree-encryption) |
| 6567 | (if (not was-modified) | ||
| 6568 | (set-buffer-modified-p nil)) | ||
| 6569 | ) | ||
| 6505 | (if (not was-modified) | 6570 | (if (not was-modified) |
| 6506 | (set-buffer-modified-p nil)) | 6571 | (set-buffer-modified-p nil)) |
| 6572 | (if editing-topic (list editing-topic editing-point)) | ||
| 6507 | ) | 6573 | ) |
| 6508 | (if (not was-modified) | ||
| 6509 | (set-buffer-modified-p nil)) | ||
| 6510 | (if editing-topic (list editing-topic editing-point)) | ||
| 6511 | ) | 6574 | ) |
| 6512 | ) | 6575 | ) |
| 6513 | ) | 6576 | ) |
| @@ -6725,13 +6788,14 @@ Optional arg SUCCESSIVE-BACKSLASHES is used internally for recursion." | |||
| 6725 | If BEG is bigger than END we return 0." | 6788 | If BEG is bigger than END we return 0." |
| 6726 | (if (> beg end) | 6789 | (if (> beg end) |
| 6727 | 0 | 6790 | 0 |
| 6728 | (save-excursion | 6791 | (save-match-data |
| 6729 | (goto-char beg) | 6792 | (save-excursion |
| 6730 | (let ((count 0)) | 6793 | (goto-char beg) |
| 6731 | (while (re-search-forward "[ ][ ]*$" end t) | 6794 | (let ((count 0)) |
| 6732 | (goto-char (1+ (match-beginning 2))) | 6795 | (while (re-search-forward "[ ][ ]*$" end t) |
| 6733 | (setq count (1+ count))) | 6796 | (goto-char (1+ (match-beginning 2))) |
| 6734 | count)))) | 6797 | (setq count (1+ count))) |
| 6798 | count))))) | ||
| 6735 | ;;;_ > allout-format-quote (string) | 6799 | ;;;_ > allout-format-quote (string) |
| 6736 | (defun allout-format-quote (string) | 6800 | (defun allout-format-quote (string) |
| 6737 | "Return a copy of string with all \"%\" characters doubled." | 6801 | "Return a copy of string with all \"%\" characters doubled." |
| @@ -6844,7 +6908,13 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." | |||
| 6844 | 6908 | ||
| 6845 | ;; Move to beginning-of-line, ignoring fields and invisibles. | 6909 | ;; Move to beginning-of-line, ignoring fields and invisibles. |
| 6846 | (skip-chars-backward "^\n") | 6910 | (skip-chars-backward "^\n") |
| 6847 | (while (and (not (bobp)) (line-move-invisible-p (1- (point)))) | 6911 | (while (and (not (bobp)) |
| 6912 | (let ((prop | ||
| 6913 | (get-char-property (1- (point)) 'invisible))) | ||
| 6914 | (if (eq buffer-invisibility-spec t) | ||
| 6915 | prop | ||
| 6916 | (or (memq prop buffer-invisibility-spec) | ||
| 6917 | (assq prop buffer-invisibility-spec))))) | ||
| 6848 | (goto-char (if (featurep 'xemacs) | 6918 | (goto-char (if (featurep 'xemacs) |
| 6849 | (previous-property-change (point)) | 6919 | (previous-property-change (point)) |
| 6850 | (previous-char-property-change (point)))) | 6920 | (previous-char-property-change (point)))) |
| @@ -6873,8 +6943,18 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." | |||
| 6873 | (error nil)) | 6943 | (error nil)) |
| 6874 | (not (bobp)) | 6944 | (not (bobp)) |
| 6875 | (progn | 6945 | (progn |
| 6876 | (while (and (not (bobp)) | 6946 | (while |
| 6877 | (line-move-invisible-p (1- (point)))) | 6947 | (and |
| 6948 | (not (bobp)) | ||
| 6949 | (let ((prop | ||
| 6950 | (get-char-property (1- (point)) | ||
| 6951 | 'invisible))) | ||
| 6952 | (if (eq buffer-invisibility-spec t) | ||
| 6953 | prop | ||
| 6954 | (or (memq prop | ||
| 6955 | buffer-invisibility-spec) | ||
| 6956 | (assq prop | ||
| 6957 | buffer-invisibility-spec))))) | ||
| 6878 | (goto-char | 6958 | (goto-char |
| 6879 | (previous-char-property-change (point)))) | 6959 | (previous-char-property-change (point)))) |
| 6880 | (backward-char 1))) | 6960 | (backward-char 1))) |
| @@ -6891,16 +6971,6 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." | |||
| 6891 | (setq arg 1) | 6971 | (setq arg 1) |
| 6892 | (setq done t))))))) | 6972 | (setq done t))))))) |
| 6893 | ) | 6973 | ) |
| 6894 | ;;;_ > line-move-invisible-p if necessary | ||
| 6895 | (if (not (fboundp 'line-move-invisible-p)) | ||
| 6896 | (defun line-move-invisible-p (pos) | ||
| 6897 | "Return non-nil if the character after POS is currently invisible." | ||
| 6898 | (let ((prop | ||
| 6899 | (get-char-property pos 'invisible))) | ||
| 6900 | (if (eq buffer-invisibility-spec t) | ||
| 6901 | prop | ||
| 6902 | (or (memq prop buffer-invisibility-spec) | ||
| 6903 | (assq prop buffer-invisibility-spec)))))) | ||
| 6904 | 6974 | ||
| 6905 | ;;;_ #10 Unfinished | 6975 | ;;;_ #10 Unfinished |
| 6906 | ;;;_ > allout-bullet-isearch (&optional bullet) | 6976 | ;;;_ > allout-bullet-isearch (&optional bullet) |