Mercurial > emacs
comparison lisp/allout.el @ 85769:de8ef384c3ef
* 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.
author | Dan Nicolaescu <dann@ics.uci.edu> |
---|---|
date | Mon, 29 Oct 2007 23:10:09 +0000 |
parents | 5039706521c9 |
children | f358a2fd5895 880960b70474 |
comparison
equal
deleted
inserted
replaced
85768:8845bb9202ff | 85769:de8ef384c3ef |
---|---|
107 :prefix "allout-" | 107 :prefix "allout-" |
108 :group 'outlines) | 108 :group 'outlines) |
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'. |
115 | 174 |
116 Setq-default by `allout-init' to regulate whether or not allout | 175 Setq-default by `allout-init' to regulate whether or not allout |
201 (const :tag ": (repeat prior)" :) | 260 (const :tag ": (repeat prior)" :) |
202 (const :tag "* (completely expose)" *) | 261 (const :tag "* (completely expose)" *) |
203 (const :tag "+ (expose all offspring, headlines only)" +) | 262 (const :tag "+ (expose all offspring, headlines only)" +) |
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>")))) |
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)))) | |
206 | 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 |
210 just the header." | 317 just the header." |
665 :type 'boolean | 772 :type 'boolean |
666 :group 'allout-developer) | 773 :group 'allout-developer) |
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. |
782 | 780 |
783 This can range from changes to existing entries, addition of new ones, | 781 This can range from changes to existing entries, addition of new ones, |
904 (defvar allout-plain-bullets-string-len (length allout-plain-bullets-string) | 902 (defvar allout-plain-bullets-string-len (length allout-plain-bullets-string) |
905 "Length of `allout-plain-bullets-string', updated by `set-allout-regexp'.") | 903 "Length of `allout-plain-bullets-string', updated 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." |
919 (interactive "sNew lead string: ") | 935 (interactive "sNew lead string: ") |
920 (setq allout-header-prefix header-lead) | 936 (setq allout-header-prefix header-lead) |
1129 Built on top of optional BASE-MAP, or empty sparse map if none specified. | 1145 Built on top of optional BASE-MAP, or empty sparse map if none specified. |
1130 See doc string for allout-keybindings-list for format of binding list." | 1146 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) |
1147 (defvar allout-mode-editing-menu) | 1163 (defvar allout-mode-editing-menu) |
1148 (defvar allout-mode-navigation-menu) | 1164 (defvar allout-mode-navigation-menu) |
2128 | 2144 |
2129 ;;;_ > allout-overlay-insert-in-front-handler (ol after beg end | 2145 ;;;_ > allout-overlay-insert-in-front-handler (ol after beg end |
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) |
2138 (defun allout-overlay-interior-modification-handler (ol after beg end | 2156 (defun allout-overlay-interior-modification-handler (ol after beg end |
2139 &optional prelen) | 2157 &optional prelen) |
2317 ;; actually connected with their prospective context. | 2335 ;; actually connected with their prospective context. |
2318 | 2336 |
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) |
2338 ;; recalibrate allout-recent-* | 2357 ;; recalibrate allout-recent-* |
2339 (allout-depth) | 2358 (allout-depth) |
2343 "Return non-nil if point is on current visible topics' header line. | 2362 "Return non-nil if point is on current visible topics' header line. |
2344 | 2363 |
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 () |
2364 "Return depth of topic most immediately containing point. | 2385 "Return depth of topic most immediately containing point. |
2365 | 2386 |
2483 | 2504 |
2484 (interactive) | 2505 (interactive) |
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 |
2492 (while (and (allout-do-doublecheck) | 2518 (while (and (allout-do-doublecheck) |
2493 (allout-aberrant-container-p) | 2519 (allout-aberrant-container-p) |
2526 (allout-show-children) | 2552 (allout-show-children) |
2527 (allout-end-of-entry)) | 2553 (allout-end-of-entry)) |
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. |
2535 | 2564 |
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." |
2552 ;; A throwaway non-macro that is defined after allout-next-heading | 2583 ;; A throwaway non-macro that is defined after allout-next-heading |
2553 ;; and usable by allout-mode. | 2584 ;; and usable by allout-mode. |
2563 (if (bobp) | 2594 (if (bobp) |
2564 nil | 2595 nil |
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." |
2582 (let ((overlays (overlays-at (point))) | 2614 (let ((overlays (overlays-at (point))) |
2583 got) | 2615 got) |
2780 | 2812 |
2781 Not sensitive to topic visibility. | 2813 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. |
2801 | 2834 |
2802 Like `allout-goto-prefix', but shallow topics (according to | 2835 Like `allout-goto-prefix', but shallow topics (according to |
2817 otherwise skip white space between bullet and ensuing text." | 2850 otherwise skip white space between bullet and ensuing text." |
2818 | 2851 |
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 () |
2829 (defun allout-current-bullet-pos () | 2863 (defun allout-current-bullet-pos () |
2830 "Return position of current (visible) topic's bullet." | 2864 "Return position of current (visible) topic's bullet." |
3102 (format allout-depth-specific-regexp | 3136 (format allout-depth-specific-regexp |
3103 depth-biased depth-biased))) | 3137 depth-biased depth-biased))) |
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))))) |
3114 (if (not found) | 3149 (if (not found) |
3115 (progn (goto-char start-point) | 3150 (progn (goto-char start-point) |
3182 ;; Move, skipping over all concealed lines in one fell swoop: | 3217 ;; Move, skipping over all concealed lines in one fell swoop: |
3183 (prog1 (condition-case nil (or (line-move step) t) | 3218 (prog1 (condition-case nil (or (line-move step) t) |
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))) |
3202 (cond (got ; Last move was to a prefix: | 3238 (cond (got ; Last move was to a prefix: |
3203 (allout-end-of-prefix)) | 3239 (allout-end-of-prefix)) |
3352 (setq mapped-binding | 3388 (setq mapped-binding |
3353 (or (and (assoc key-string allout-keybindings-list) | 3389 (or (and (assoc key-string allout-keybindings-list) |
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" |
3361 (- key-num 96) key-num))) | 3397 (- key-num 96) key-num))) |
3362 t)))) | 3398 t)))) |
3621 can easily create a sibling in front of the current topic without | 3657 can easily create a sibling in front of the current topic without |
3622 having to go to its preceding sibling, and then open forward | 3658 having to go to its preceding sibling, and then open forward |
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)) |
3772 | 3799 (insert (concat (allout-make-topic-prefix opening-numbered t depth) |
3773 (run-hook-with-args 'allout-structure-added-hook start end) | 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) | |
3809 | |
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) |
3777 (defun allout-open-subtopic (arg) | 3815 (defun allout-open-subtopic (arg) |
3778 "Open new topic header at deeper level than the current one. | 3816 "Open new topic header at deeper level than the current one. |
3814 `allout-use-hanging-indents' is set." | 3852 `allout-use-hanging-indents' is set." |
3815 | 3853 |
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))) |
3830 (if (or allout-former-auto-filler allout-use-hanging-indents) | 3869 (if (or allout-former-auto-filler allout-use-hanging-indents) |
3831 (funcall use-auto-fill-function))))) | 3870 (funcall use-auto-fill-function))))) |
3965 ; get rid of old one: | 4004 ; get rid of old one: |
3966 (allout-unprotected (delete-region mb me)) | 4005 (allout-unprotected (delete-region mb me)) |
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 |
3978 (put-text-property 0 (length new-prefix) 'allout-was-hidden t | 4018 (put-text-property 0 (length new-prefix) 'allout-was-hidden t |
3979 new-prefix)) | 4019 new-prefix)) |
4295 | 4335 |
4296 (interactive "*P") | 4336 (interactive "*P") |
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: |
4304 (let* ((beg (point)) | 4344 (let* ((beg (point)) |
4305 end | 4345 end |
4315 (kill-line arg)) | 4355 (kill-line arg)) |
4316 (allout-deannotate-hidden beg end) | 4356 (allout-deannotate-hidden beg end) |
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))))) |
4324 ;;;_ > allout-copy-line-as-kill () | 4364 ;;;_ > allout-copy-line-as-kill () |
4325 (defun allout-copy-line-as-kill () | 4365 (defun allout-copy-line-as-kill () |
4350 (depth allout-recent-depth)) | 4390 (depth allout-recent-depth)) |
4351 (allout-end-of-current-subtree) | 4391 (allout-end-of-current-subtree) |
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))) |
4359 (and (> (- beg (point-min)) 3) | 4399 (and (> (- beg (point-min)) 3) |
4360 (string= (buffer-substring (- beg 2) beg) "\n\n")))) | 4400 (string= (buffer-substring (- beg 2) beg) "\n\n")))) |
4447 (setq done t) | 4487 (setq done t) |
4448 ;; advance to just after end of this annotation: | 4488 ;; advance to just after end of this annotation: |
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) |
4456 (if next (goto-char next))))) | 4496 (if next (goto-char next))))) |
4457 (set-buffer-modified-p was-modified)))) | 4497 (set-buffer-modified-p was-modified)))) |
4479 (interactive "*P") | 4519 (interactive "*P") |
4480 ; Get to beginning, leaving | 4520 ; Get to beginning, leaving |
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. |
4598 | 4641 |
4599 Non-topic yanks work no differently than normal yanks. | 4642 Non-topic yanks work no differently than normal yanks. |
4656 (if (not (string= (allout-current-bullet) allout-file-xref-bullet)) | 4699 (if (not (string= (allout-current-bullet) allout-file-xref-bullet)) |
4657 (error "Current heading lacks cross-reference bullet `%s'" | 4700 (error "Current heading lacks cross-reference bullet `%s'" |
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) |
4671 (y-or-n-p (format "%s not there, create one? " | 4716 (y-or-n-p (format "%s not there, create one? " |
4672 file-name)) | 4717 file-name)) |
4693 invoked.)" | 4738 invoked.)" |
4694 | 4739 |
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))) |
4702 (while props | 4747 (while props |
4703 (overlay-put o (pop props) (pop props))))))) | 4748 (overlay-put o (pop props) (pop props))))))) |
4896 | 4941 |
4897 Single line topics intrinsically can be considered as being both | 4942 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. |
4914 | 4960 |
4915 If this topic is closed and it's a top level topic, close this topic | 4961 If this topic is closed and it's a top level topic, close this topic |
4929 (message sibs-msg) | 4975 (message sibs-msg) |
4930 (allout-goto-prefix-doublechecked) | 4976 (allout-goto-prefix-doublechecked) |
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." |
4937 (interactive) | 4993 (interactive) |
4938 (let ((inhibit-field-text-motion t)) | 4994 (let ((inhibit-field-text-motion t)) |
4960 (interactive) | 5016 (interactive) |
4961 (allout-hide-region-body (point-min) (point-max))) | 5017 (allout-hide-region-body (point-min) (point-max))) |
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) |
4980 "Apply exposure specs to successive outline topic items. | 5037 "Apply exposure specs to successive outline topic items. |
4981 | 5038 |
5594 (let ((inhibit-field-text-motion t)) | 5651 (let ((inhibit-field-text-motion t)) |
5595 (beginning-of-line) | 5652 (beginning-of-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." |
5610 ;; Much of this is being derived from the stuff in appendix of E in | 5668 ;; Much of this is being derived from the stuff in appendix of E in |
5611 ;; the TeXBook, pg 421. | 5669 ;; the TeXBook, pg 421. |
6048 (when (and strip-plaintext-regexps (not decrypt)) | 6106 (when (and strip-plaintext-regexps (not decrypt)) |
6049 (dolist (re strip-plaintext-regexps) | 6107 (dolist (re strip-plaintext-regexps) |
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 |
6058 ;; symmetric: | 6117 ;; symmetric: |
6059 ((equal key-type 'symmetric) | 6118 ((equal key-type 'symmetric) |
6280 "True if the current topic is encryptable and encrypted." | 6339 "True if the current topic is encryptable and encrypted." |
6281 (save-excursion | 6340 (save-excursion |
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) |
6289 ;; XXX gpg-specific, alas | 6348 ;; XXX gpg-specific, alas |
6290 (defun allout-encrypted-key-info (text) | 6349 (defun allout-encrypted-key-info (text) |
6418 | 6477 |
6419 Such a topic has the allout-topic-encryption-bullet without an | 6478 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 | 6484 |
6426 (format "\\(\\`\\|\n\\)%s *%s[^*]" | 6485 (if (not (re-search-forward |
6427 (regexp-quote allout-header-prefix) | 6486 (format "\\(\\`\\|\n\\)%s *%s[^*]" |
6428 (regexp-quote allout-topic-encryption-bullet)) | 6487 (regexp-quote allout-header-prefix) |
6429 nil t)) | 6488 (regexp-quote allout-topic-encryption-bullet)) |
6430 (setq got nil | 6489 nil t)) |
6431 done t) | 6490 (setq got nil |
6432 (goto-char (setq got (match-beginning 0))) | 6491 done t) |
6433 (if (looking-at "\n") | 6492 (goto-char (setq got (match-beginning 0))) |
6434 (forward-char 1)) | 6493 (if (save-match-data (looking-at "\n")) |
6435 (setq got (point))) | 6494 (forward-char 1)) |
6436 | 6495 (setq got (point))) |
6437 (cond ((not got) | 6496 |
6438 (setq done t)) | 6497 (cond ((not got) |
6439 | 6498 (setq done t)) |
6440 ((not (search-forward "\n")) | 6499 |
6441 (setq got nil | 6500 ((not (search-forward "\n")) |
6442 done t)) | 6501 (setq got nil |
6443 | 6502 done t)) |
6444 ((eobp) | 6503 |
6445 (setq got nil | 6504 ((eobp) |
6446 done t)) | 6505 (setq got nil |
6447 | 6506 done t)) |
6448 (t | 6507 |
6449 (setq content-beg (point)) | 6508 (t |
6450 (backward-char 1) | 6509 (setq content-beg (point)) |
6451 (allout-end-of-subtree) | 6510 (backward-char 1) |
6452 (if (or (<= (point) content-beg) | 6511 (allout-end-of-subtree) |
6453 (and except-mark | 6512 (if (or (<= (point) content-beg) |
6454 (<= content-beg except-mark) | 6513 (and except-mark |
6455 (>= (point) except-mark))) | 6514 (<= content-beg except-mark) |
6456 ;; Continue looking | 6515 (>= (point) except-mark))) |
6457 (setq got nil) | 6516 ;; Continue looking |
6458 ;; Got it! | 6517 (setq got nil) |
6459 (setq done t))) | 6518 ;; Got it! |
6460 ) | 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) |
6467 (defun allout-encrypt-decrypted (&optional except-mark) | 6528 (defun allout-encrypt-decrypted (&optional except-mark) |
6468 "Encrypt topics pending encryption except those containing exemption point. | 6529 "Encrypt topics pending encryption except those containing exemption point. |
6476 before the topic was encrypted. This can be used, eg, to decrypt the topic | 6537 before the topic was encrypted. This can be used, eg, to decrypt the topic |
6477 and exactly resituate the cursor if this is being done as part of a file | 6538 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 ) |
6514 | 6577 |
6515 ;;;_ #9 miscellaneous | 6578 ;;;_ #9 miscellaneous |
6723 "Return number of trailing whitespace chars between BEG and END. | 6786 "Return number of trailing whitespace chars between BEG and END. |
6724 | 6787 |
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." |
6738 (apply 'concat | 6802 (apply 'concat |
6739 (mapcar (lambda (char) (if (= char ?%) "%%" (char-to-string char))) | 6803 (mapcar (lambda (char) (if (= char ?%) "%%" (char-to-string char))) |
6842 (if (/= arg 1) | 6906 (if (/= arg 1) |
6843 (condition-case nil (line-move (1- arg)) (error nil))) | 6907 (condition-case nil (line-move (1- arg)) (error nil))) |
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)))) |
6851 (skip-chars-backward "^\n")) | 6921 (skip-chars-backward "^\n")) |
6852 (vertical-motion 0)) | 6922 (vertical-motion 0)) |
6871 (and (condition-case nil | 6941 (and (condition-case nil |
6872 (or (line-move arg) t) | 6942 (or (line-move arg) 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))) |
6881 (point))))) | 6961 (point))))) |
6882 (goto-char newpos) | 6962 (goto-char newpos) |
6889 ;; and now we're not really at eol, | 6969 ;; and now we're not really at eol, |
6890 ;; keep going. | 6970 ;; keep going. |
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) |
6907 (defun allout-bullet-isearch (&optional bullet) | 6977 (defun allout-bullet-isearch (&optional bullet) |
6908 "Isearch (regexp) for topic with bullet BULLET." | 6978 "Isearch (regexp) for topic with bullet BULLET." |