Mercurial > emacs
comparison lisp/allout.el @ 7416:4996c50431de
(outline-init) New user interface for control of
outline-mode session setup, sets up `outline-find-file-hook',
`outline-layout', and `outline-auto-activation'.
(outline-mode-post-command-business, outline-mode)
(outlineify-sticky): Major new mode activation
scheme. See outline-layout docstring for details.
(outline-layout, outline-use-mode-specific-leader)
(outline-mode-leaders): Variables for new mode-activation scheme.
(outline-expose-topic): New specification format and
optimizations, including thorough accomodation of multiple top-level topics.
(outline-forward-current-level, outline-next-sibling)
(outline-backward-current-level, outline-goto-prefix)
(outline-show-children, outline-up-current-level)
(outline-expose-topic): Behavior refinements and repairs, and
speed optimizations. Better accomodation for multiple top-level topics.
(outline-recent-end-of-subtree): New state var,
basis for many topic-oriented optimizations.
Revisions of many docstrings, for conformance to
GNU standards and/or clarity.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Mon, 09 May 1994 06:36:19 +0000 |
parents | 49f9f9a08b4c |
children | d1cbb5dd3434 |
comparison
equal
deleted
inserted
replaced
7415:fbea5637a4b4 | 7416:4996c50431de |
---|---|
1 ;; allout.el - An extensive outline-mode for Emacs. | 1 ;;;_* allout.el - Extensive outline mode for use alone and with other modes. |
2 ;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. | 2 |
3 ;;;_* Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. | |
3 | 4 |
4 ;; Author: Ken Manheimer <klm@nist.gov> | 5 ;; Author: Ken Manheimer <klm@nist.gov> |
5 ;; Maintainer: Ken Manheimer <klm@nist.gov> | 6 ;; Maintainer: Ken Manheimer <klm@nist.gov> |
6 ;; Created: Dec 1991 - first release to usenet | 7 ;; Created: Dec 1991 - first release to usenet |
7 ;; Version: $Id: allout.el,v 3.39 1994/03/05 17:39:51 klm Exp klm $|| | 8 ;; Version: $Id: allout.el,v 4.1 1994/05/05 23:52:43 klm Exp klm $|| |
8 ;; Keywords: outline mode | 9 ;; Keywords: outline mode |
9 | 10 |
10 ;; This file is part of GNU Emacs. | 11 ;; This file is part of GNU Emacs. |
11 | 12 |
12 ;; GNU Emacs is free software; you can redistribute it and/or modify | 13 ;; GNU Emacs is free software; you can redistribute it and/or modify |
21 | 22 |
22 ;; You should have received a copy of the GNU General Public License | 23 ;; You should have received a copy of the GNU General Public License |
23 ;; along with GNU Emacs; see the file COPYING. If not, write to | 24 ;; along with GNU Emacs; see the file COPYING. If not, write to |
24 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | 25 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. |
25 | 26 |
26 ;;; Note - the lines beginning with ';;;_' are outline topic headers. | 27 ;;;_* Commentary: |
27 ;;; Load this file (or 'eval-current-buffer') and revisit the | 28 |
28 ;;; file to give it a whirl. | 29 ;; Allout outline mode provides extensive outline formatting and |
29 | 30 ;; manipulation capabilities, subsuming and well beyond that of |
30 ;;;_* Provide | 31 ;; standard emacs outline mode. It is specifically aimed at |
31 (provide 'outline) | 32 ;; supporting outline structuring and manipulation of syntax- |
32 | 33 ;; sensitive text, eg programming languages. (For an example, see the |
33 ;;;_ + LCD Archive Entry | 34 ;; allout code itself, which is organized in outline structure.) |
34 | 35 ;; |
35 ;;;_ + Description | 36 ;; It also includes such things as topic-oriented repositioning, cut, and |
36 ;; A full-fledged outline mode, based on the original rudimentary | 37 ;; paste; integral outline exposure-layout; incremental search with |
37 ;; GNU emacs outline functionality. | 38 ;; dynamic exposure/conceament of concealed text; automatic topic-number |
39 ;; maintenance; and many other features. | |
40 ;; | |
41 ;; See the docstring of the variables `outline-layout' and | |
42 ;; `outline-auto-activation' for details on automatic activation of | |
43 ;; allout outline-mode as a minor mode. (It has changed since allout | |
44 ;; 3.x, for those of you that depend on the old method.) | |
38 ;; | 45 ;; |
46 ;; Note - the lines beginning with ';;;_' are outline topic headers. | |
47 ;; Just 'ESC-x eval-current-buffer' to give it a whirl. | |
48 | |
39 ;;Ken Manheimer 301 975-3539 | 49 ;;Ken Manheimer 301 975-3539 |
40 ;;ken.manheimer@nist.gov FAX: 301 963-9137 | 50 ;;ken.manheimer@nist.gov FAX: 301 963-9137 |
41 ;; | 51 ;; |
42 ;;Computer Systems and Communications Division | 52 ;;Computer Systems and Communications Division |
43 ;; | 53 ;; |
44 ;; Nat'l Institute of Standards and Technology | 54 ;; Nat'l Institute of Standards and Technology |
45 ;; Technology A151 | 55 ;; Technology A151 |
46 ;; Gaithersburg, MD 20899 | 56 ;; Gaithersburg, MD 20899 |
47 | 57 |
48 ;;;_* User Customization variables | 58 ;;;_* Provide |
49 | 59 (provide 'outline) |
50 ;;;_ + Topic Header configuration | 60 (provide 'allout) |
61 | |
62 ;;;_* USER CUSTOMIZATION VARIABLES: | |
63 | |
64 ;;;_ + Layout, Mode, and Topic Header Configuration | |
65 | |
66 ;;;_ = outline-auto-activation | |
67 (defvar outline-auto-activation nil | |
68 "*Regulates auto-activation modality of allout outlines - see `outline-init'. | |
69 | |
70 Setq-default by `outline-init' to regulate whether or not allout | |
71 outline mode is automatically activated when the buffer-specific | |
72 variable `outline-layout' is non-nil, and whether or not the layout | |
73 dictated by `outline-layout' should be imposed on mode activation. | |
74 | |
75 With value `t', auto-mode-activation and auto-layout are enabled. | |
76 \(This also depends on `outline-find-file-hooks' being installed in | |
77 `find-file-hooks', which is also done by `outline-init'.) | |
78 | |
79 With value `ask', auto-mode-activation is enabled, and endorsement for | |
80 performing auto-layout is asked of the user each time. | |
81 | |
82 With value `activate', only auto-mode-activation is enabled, auto- | |
83 layout is not. | |
84 | |
85 With value `nil', neither auto-mode-activation nor auto-layout are | |
86 enabled. | |
87 | |
88 See the docstring for `outline-init' for the proper interface to | |
89 this variable.") | |
90 ;;;_ = outline-layout | |
91 (defvar outline-layout nil | |
92 "*Layout specification and provisional mode trigger for allout outlines. | |
93 | |
94 Buffer-specific. | |
95 | |
96 A list value specifies a default layout for the current buffer, to be | |
97 applied upon activation of allout outline-mode. Any non-nil value | |
98 will automatically trigger allout outline-mode, provided `outline- | |
99 init' has been called to enable it. | |
100 | |
101 See the docstring for `outline-init' for details on setting up for | |
102 auto-mode-activation, and for `outline-expose-topic' for the format of | |
103 the layout specification. | |
104 | |
105 You can associate a particular outline layout with a file by setting | |
106 this var via the file's local variables. For example, the following | |
107 lines at the bottom of an elisp file: | |
108 | |
109 ;;;Local variables: | |
110 ;;;outline-layout: \(0 : -1 -1 0\) | |
111 ;;;End: | |
112 | |
113 will, modulo the above-mentioned conditions, cause the mode to be | |
114 activated when the file is visited, followed by the equivalent of | |
115 `\(outline-expose-topic 0 : -1 -1 0\)'. \(This is the layout used for | |
116 the allout.el, itself.) | |
117 | |
118 Also, allout's mode-specific provisions will make topic prefixes | |
119 default to the comment-start string, if any, of the language of the | |
120 file. This is modulo the setting of `outline-use-mode-specific- | |
121 leader', which see.") | |
122 (make-variable-buffer-local 'outline-layout) | |
51 | 123 |
52 ;;;_ = outline-header-prefix | 124 ;;;_ = outline-header-prefix |
53 (defvar outline-header-prefix "." | 125 (defvar outline-header-prefix "." |
54 "*Outline topic header lines are identified by a leading topic | 126 "*Leading string which helps distinguish topic headers. |
127 | |
128 Outline topic header lines are identified by a leading topic | |
55 header prefix, which mostly have the value of this var at their front. | 129 header prefix, which mostly have the value of this var at their front. |
56 \(Level 1 topics are exceptions. They consist of only a single | 130 \(Level 1 topics are exceptions. They consist of only a single |
57 character, which is typically set to the outline-primary-bullet.") | 131 character, which is typically set to the outline-primary-bullet. Many |
132 outlines start at level 2 to avoid this discrepancy.") | |
58 (make-variable-buffer-local 'outline-header-prefix) | 133 (make-variable-buffer-local 'outline-header-prefix) |
59 | |
60 ;;;_ = outline-mode-leaders | |
61 (defvar outline-mode-leaders | |
62 '((emacs-lisp-mode . "\;\;\;_") | |
63 (lisp-mode . "\;\;\;_") | |
64 (awk-mode . "#") | |
65 (csh-mode . "#") | |
66 (sh-mode . "#") | |
67 (tcl-mode . "#") | |
68 (perl-mode . "#") | |
69 (c++-mode "//_") | |
70 (c-mode "/*_")) | |
71 "Respective outline-prefix leading strings per major modes. The | |
72 strings should begin with a comment string for the mode. Preferably, | |
73 they would have an extra character, eg an \"_\" underscore, to | |
74 distinguish the lead string from regular comments that start at bol. | |
75 \'#'-commented script modes, however, may need to use a bar \'#' in | |
76 order for the script magic number \'#!' to serve as the top-level | |
77 topic.") | |
78 | |
79 ;;;_ = outline-primary-bullet | 134 ;;;_ = outline-primary-bullet |
80 (defvar outline-primary-bullet "*" | 135 (defvar outline-primary-bullet "*" |
81 "Outline topic header lines are identified by a leading topic header | 136 "Bullet used for top-level outline topics. |
137 | |
138 Outline topic header lines are identified by a leading topic header | |
82 prefix, which is concluded by bullets that includes the value of this | 139 prefix, which is concluded by bullets that includes the value of this |
83 var and the respective outline-*-bullets-string vars. | 140 var and the respective outline-*-bullets-string vars. |
84 | 141 |
85 The value of an asterisk ('*') provides for backwards compatability | 142 The value of an asterisk ('*') provides for backwards compatability |
86 with the original emacs outline mode. See outline-plain-bullets-string | 143 with the original emacs outline mode. See outline-plain-bullets-string |
87 and outline-distinctive-bullets-string for the range of available | 144 and outline-distinctive-bullets-string for the range of available |
88 bullets.") | 145 bullets.") |
89 (make-variable-buffer-local 'outline-primary-bullet) | 146 (make-variable-buffer-local 'outline-primary-bullet) |
90 | |
91 ;;;_ = outline-plain-bullets-string | 147 ;;;_ = outline-plain-bullets-string |
92 (defvar outline-plain-bullets-string (concat outline-primary-bullet | 148 (defvar outline-plain-bullets-string (concat outline-primary-bullet |
93 "+-:.;,") | 149 "+-:.;,") |
94 "*The bullets normally used in outline topic prefixes. See | 150 "*The bullets normally used in outline topic prefixes. |
95 'outline-distinctive-bullets-string' for the other kind of | 151 |
152 See 'outline-distinctive-bullets-string' for the other kind of | |
96 bullets. | 153 bullets. |
97 | 154 |
98 DO NOT include the close-square-bracket, ']', as a bullet. | 155 DO NOT include the close-square-bracket, ']', as a bullet. |
99 | 156 |
100 Outline mode has to be reactivated in order for changes to the value | 157 Outline mode has to be reactivated in order for changes to the value |
101 of this var to take effect.") | 158 of this var to take effect.") |
102 (make-variable-buffer-local 'outline-plain-bullets-string) | 159 (make-variable-buffer-local 'outline-plain-bullets-string) |
103 | |
104 ;;;_ = outline-distinctive-bullets-string | 160 ;;;_ = outline-distinctive-bullets-string |
105 (defvar outline-distinctive-bullets-string "=>([{}&!?#%\"X@$~\\" | 161 (defvar outline-distinctive-bullets-string "=>([{}&!?#%\"X@$~\\" |
106 "*The bullets used for distinguishing outline topics. These | 162 "*Persistent outline header bullets used to distinguish special topics. |
107 bullets are not offered among the regular rotation, and are not | 163 |
108 changed when automatically rebulleting, as when shifting the | 164 These bullets are not offered among the regular, level-specific |
109 level of a topic. See 'outline-plain-bullets-string' for the | 165 rotation, and are not altered by automatic rebulleting, as when |
110 other kind of bullets. | 166 shifting the level of a topic. See `outline-plain-bullets-string' for |
111 | 167 the selection of alternating bullets. |
112 DO NOT include the close-square-bracket, ']', among any bullets. | |
113 | 168 |
114 You must run 'set-outline-regexp' in order for changes | 169 You must run 'set-outline-regexp' in order for changes |
115 to the value of this var to effect outline-mode operation.") | 170 to the value of this var to effect outline-mode operation. |
171 | |
172 DO NOT include the close-square-bracket, ']', on either of the bullet | |
173 strings.") | |
116 (make-variable-buffer-local 'outline-distinctive-bullets-string) | 174 (make-variable-buffer-local 'outline-distinctive-bullets-string) |
175 | |
176 ;;;_ = outline-use-mode-specific-leader | |
177 (defvar outline-use-mode-specific-leader t | |
178 "*When non-nil, use mode-specific topic-header prefixes. | |
179 | |
180 Allout outline mode will use the mode-specific `outline-mode-leaders' | |
181 and/or comment-start string, if any, to lead the topic prefix string, | |
182 so topic headers look like comments in the programming language. | |
183 | |
184 String values are used as they stand. | |
185 | |
186 Value `t' means to first check for assoc value in `outline-mode-leaders' | |
187 alist, then use comment-start string, if any, then use default \(`.'). | |
188 \(See note about use of comment-start strings, below.\) | |
189 | |
190 Set to the symbol for either of `outline-mode-leaders' or | |
191 `comment-start' to use only one of them, respectively. | |
192 | |
193 Value `nil' means to always use the default \(`.'\). | |
194 | |
195 comment-start strings that do not end in spaces are tripled, and an | |
196 '_' underscore is tacked on the end, to distinguish them from regular | |
197 comment strings. comment-start strings that do end in spaces are not | |
198 tripled, but an underscore is substituted for the space. \[This | |
199 presumes that the space is for appearance, not comment syntax. You | |
200 can use `outline-mode-leaders' to override this behavior, when | |
201 incorrect.\]") | |
202 ;;;_ = outline-mode-leaders | |
203 (defvar outline-mode-leaders '() | |
204 "Specific outline-prefix leading strings per major modes. | |
205 | |
206 Entries will be used in the stead (or lieu) of mode-specific | |
207 comment-start strings. See also `outline-use-mode-specific-leader'. | |
208 | |
209 If you're constructing a string that will comment-out outline | |
210 structuring so it can be included in program code, append an extra | |
211 character, like an \"_\" underscore, to distinguish the lead string | |
212 from regular comments that start at bol.") | |
117 | 213 |
118 ;;;_ = outline-old-style-prefixes | 214 ;;;_ = outline-old-style-prefixes |
119 (defvar outline-old-style-prefixes nil | 215 (defvar outline-old-style-prefixes nil |
120 "*Non-nil restricts the topic creation and modification | 216 "*When non-nil, use only old-and-crusty outline-mode '*' topic prefixes. |
217 | |
218 Non-nil restricts the topic creation and modification | |
121 functions to asterix-padded prefixes, so they look exactly | 219 functions to asterix-padded prefixes, so they look exactly |
122 like the original emacs-outline style prefixes. | 220 like the original emacs-outline style prefixes. |
123 | 221 |
124 Whatever the setting of this variable, both old and new style prefixes | 222 Whatever the setting of this variable, both old and new style prefixes |
125 are always respected by the topic maneuvering functions.") | 223 are always respected by the topic maneuvering functions.") |
126 (make-variable-buffer-local 'outline-old-style-prefixes) | 224 (make-variable-buffer-local 'outline-old-style-prefixes) |
127 | 225 ;;;_ = outline-stylish-prefixes - alternating bullets |
128 ;;;_ = outline-stylish-prefixes - new fangled topic prefixes | |
129 (defvar outline-stylish-prefixes t | 226 (defvar outline-stylish-prefixes t |
130 "*Non-nil allows the topic creation and modification | 227 "*Do fancy stuff with topic prefix bullets according to level, etc. |
131 functions to vary the topic bullet char (the char that marks | 228 |
132 the topic depth) just preceding the start of the topic text) | 229 Non-nil enables topic creation, modification, and repositioning |
133 according to level. Otherwise, only asterisks ('*') and | 230 functions to vary the topic bullet char (the char that marks the topic |
134 distinctive bullets are used. | 231 depth) just preceding the start of the topic text) according to level. |
135 | 232 Otherwise, only asterisks ('*') and distinctive bullets are used. |
136 This is how an outline can look with stylish prefixes: | 233 |
234 This is how an outline can look (but sans indentation) with stylish | |
235 prefixes: | |
137 | 236 |
138 * Top level | 237 * Top level |
139 .* A topic | 238 .* A topic |
140 . + One level 3 subtopic | 239 . + One level 3 subtopic |
141 . . One level 4 subtopic | 240 . . One level 4 subtopic |
241 . . A second 4 subtopic | |
142 . + Another level 3 subtopic | 242 . + Another level 3 subtopic |
143 . . A level 4 subtopic | 243 . #1 A numbered level 4 subtopic |
144 . #2 A distinguished, numbered level 4 subtopic | 244 . #2 Another |
145 . ! A distinguished ('!') level 4 subtopic | 245 . ! Another level 4 subtopic with a different distinctive bullet |
146 . #4 Another numbered level 4 subtopic | 246 . #4 And another numbered level 4 subtopic |
147 | 247 |
148 This would be an outline with stylish prefixes inhibited: | 248 This would be an outline with stylish prefixes inhibited (but the |
249 numbered and other distinctive bullets retained): | |
149 | 250 |
150 * Top level | 251 * Top level |
151 .* A topic | 252 .* A topic |
152 .! A distinctive (but measly) subtopic | 253 . * One level 3 subtopic |
153 . * A sub-subtopic - no bullets from outline-plain-bullets-string but '*' | 254 . * One level 4 subtopic |
255 . * A second 4 subtopic | |
256 . * Another level 3 subtopic | |
257 . #1 A numbered level 4 subtopic | |
258 . #2 Another | |
259 . ! Another level 4 subtopic with a different distinctive bullet | |
260 . #4 And another numbered level 4 subtopic | |
154 | 261 |
155 Stylish and constant prefixes (as well as old-style prefixes) are | 262 Stylish and constant prefixes (as well as old-style prefixes) are |
156 always respected by the topic maneuvering functions, regardless of | 263 always respected by the topic maneuvering functions, regardless of |
157 this variable setting. | 264 this variable setting. |
158 | 265 |
160 is non-nil.") | 267 is non-nil.") |
161 (make-variable-buffer-local 'outline-stylish-prefixes) | 268 (make-variable-buffer-local 'outline-stylish-prefixes) |
162 | 269 |
163 ;;;_ = outline-numbered-bullet | 270 ;;;_ = outline-numbered-bullet |
164 (defvar outline-numbered-bullet "#" | 271 (defvar outline-numbered-bullet "#" |
165 "*Topics having this bullet have automatic maintainence of a sibling | 272 "*String designating bullet of topics that have auto-numbering; nil for none. |
166 sequence number tacked on just after the bullet. Conventionally set | 273 |
274 Topics having this bullet have automatic maintainence of a sibling | |
275 sequence-number tacked on, just after the bullet. Conventionally set | |
167 to \"#\", you can set it to a bullet of your choice. A nil value | 276 to \"#\", you can set it to a bullet of your choice. A nil value |
168 disables numbering maintainence.") | 277 disables numbering maintainence.") |
169 (make-variable-buffer-local 'outline-numbered-bullet) | 278 (make-variable-buffer-local 'outline-numbered-bullet) |
170 | |
171 ;;;_ = outline-file-xref-bullet | 279 ;;;_ = outline-file-xref-bullet |
172 (defvar outline-file-xref-bullet "@" | 280 (defvar outline-file-xref-bullet "@" |
173 "*Set this var to the bullet you want to use for file cross-references. | 281 "*Bullet signifying file cross-references, for `outline-resolve-xref'. |
282 | |
283 Set this var to the bullet you want to use for file cross-references. | |
174 Set it 'nil' if you want to inhibit this capability.") | 284 Set it 'nil' if you want to inhibit this capability.") |
175 | 285 |
176 ;;;_ + LaTeX formatting | 286 ;;;_ + LaTeX formatting |
177 ;;;_ - outline-number-pages | 287 ;;;_ - outline-number-pages |
178 (defvar outline-number-pages nil | 288 (defvar outline-number-pages nil |
204 | 314 |
205 ;;;_ = outline-keybindings-list | 315 ;;;_ = outline-keybindings-list |
206 ;;; You have to reactivate outline-mode - '(outline-mode t)' - to | 316 ;;; You have to reactivate outline-mode - '(outline-mode t)' - to |
207 ;;; institute changes to this var. | 317 ;;; institute changes to this var. |
208 (defvar outline-keybindings-list () | 318 (defvar outline-keybindings-list () |
209 "*List of outline-mode key / function bindings, they will be locally | 319 "*List of outline-mode key / function bindings. |
210 bound on the outline-mode-map. The keys will be prefixed by | 320 |
211 outline-command-prefix unless the cell contains a third, no-nil | 321 These bindings will be locally bound on the outline-mode-map. The |
212 element, in which case the initial string will be used as is.") | 322 keys will be prefixed by outline-command-prefix, unless the cell |
323 contains a third, no-nil element, in which case the initial string | |
324 will be used as is.") | |
213 (setq outline-keybindings-list | 325 (setq outline-keybindings-list |
214 '( | 326 '( |
215 ; Motion commands: | 327 ; Motion commands: |
216 ("?t" outline-latexify-exposed) | 328 ("?t" outline-latexify-exposed) |
217 ("\C-n" outline-next-visible-heading) | 329 ("\C-n" outline-next-visible-heading) |
250 | 362 |
251 ;;;_ = outline-command-prefix | 363 ;;;_ = outline-command-prefix |
252 (defvar outline-command-prefix "\C-c" | 364 (defvar outline-command-prefix "\C-c" |
253 "*Key sequence to be used as prefix for outline mode command key bindings.") | 365 "*Key sequence to be used as prefix for outline mode command key bindings.") |
254 | 366 |
255 ;;;_ = outline-enwrap-isearch-mode - any non-nil value fine in Emacs 19. | 367 ;;;_ = outline-enwrap-isearch-mode |
256 (defvar outline-enwrap-isearch-mode "isearch-mode.el" | 368 (defvar outline-enwrap-isearch-mode t |
257 "*Set this var non-nil if you're using Emacs 19 or Lucid emacs, or | 369 "*Set non-nil to enable automatic exposure of concealed isearch targets. |
258 you're using Dan LaLiberte's 'isearch-mode' stuff. (If you have | 370 |
259 LaLiberte's package available but its' typically loaded, set the | 371 If non-nil, isearch will expose hidden text encountered in the course |
260 var to the name of the text, not the byte-compiled, load file.) | 372 of a search, and to reconceal it if the search is continued past it.") |
261 | |
262 The new isearch is required if you want isearches to expose hidden | |
263 stuff encountered in the course of a search, and to reconceal it if | |
264 you go past. | |
265 | |
266 Set the var nil if you're not using emacs 19 and you don't have the | |
267 elisp-archive package, or if want to disable this feature.") | |
268 | 373 |
269 ;;;_ = outline-use-hanging-indents | 374 ;;;_ = outline-use-hanging-indents |
270 (defvar outline-use-hanging-indents t | 375 (defvar outline-use-hanging-indents t |
271 "*When non-nil, the default auto-indent for text of topic bodies is | 376 "*If non-nil, topic body text auto-indent defaults to indent of the header. |
272 set to be even with the leading text of the header. Ie, it is | 377 Ie, it is indented to be just past the header prefix. This is |
273 indented to be just past the header prefix. This is relevant mostly | 378 relevant mostly for use with indented-text-mode, or other situations |
274 for use with indented-text-mode, or other situations where auto-fill | 379 where auto-fill occurs. |
275 occurs. | |
276 | 380 |
277 [This feature no longer depends in any way on the 'filladapt.el' | 381 [This feature no longer depends in any way on the 'filladapt.el' |
278 lisp-archive package.]") | 382 lisp-archive package.]") |
279 (make-variable-buffer-local 'outline-use-hanging-indents) | 383 (make-variable-buffer-local 'outline-use-hanging-indents) |
280 | 384 |
281 ;;;_ = outline-reindent-bodies | 385 ;;;_ = outline-reindent-bodies |
282 (defvar outline-reindent-bodies outline-use-hanging-indents | 386 (defvar outline-reindent-bodies outline-use-hanging-indents |
283 "*Set this var non-nil if you want topic depth adjustments to | 387 "*Non-nil enables auto-adjust of topic body hanging indent with depth shifts. |
284 reindent hanging bodies so they remain even with the beginning | 388 |
285 of heading text.") | 389 Indented hanging bodies are adjusted to remain even with \(or |
390 right-indented from\) the beginning of heading text.") | |
286 (make-variable-buffer-local 'outline-reindent-bodies) | 391 (make-variable-buffer-local 'outline-reindent-bodies) |
287 | |
288 ;;;_ = outline-sticky-header-motion | |
289 (defvar outline-sticky-header-motion t | |
290 "*Non-nil means that outline-{next,previous}-line or topic, bound | |
291 to keys typically dedicated to {next,previous}-line, will move by | |
292 topics when the cursor is moving from the first character of topic- | |
293 header text. You can always move the cursor off of that first-char | |
294 \"hot spot\" when you want to do regular next/previous line motions.") | |
295 (make-variable-buffer-local 'outline-sticky-header-motion) | |
296 | 392 |
297 ;;;_ = outline-inhibit-protection | 393 ;;;_ = outline-inhibit-protection |
298 (defvar outline-inhibit-protection nil | 394 (defvar outline-inhibit-protection nil |
299 "*Outline mode uses emacs change-triggered functions (not available | 395 "*Non-nil disables warnings and confirmation-checks for concealed-text edits. |
300 before emacs 19) to detect unruly changes to concealed regions. Set | 396 |
301 this var non-nil to disable the protection, potentially increasing | 397 Outline mode uses emacs change-triggered functions to detect unruly |
302 text-entry responsiveness a bit. | 398 changes to concealed regions. Set this var non-nil to disable the |
303 | 399 protection, potentially increasing text-entry responsiveness a bit. |
304 The effect of this var occurs at outline-mode activation, so you may | 400 |
305 have to deactivate and then reactivate if you want to toggle the | 401 This var takes effect at outline-mode activation, so you may have to |
402 deactivate and then reactivate the mode if you want to toggle the | |
306 behavior.") | 403 behavior.") |
307 | 404 |
308 ;;;_* Code - no user customizations below. | 405 ;;;_* CODE - no user customizations below. |
309 | 406 |
310 ;;;_ #1 Outline Format, Internal Configuration, and Mode Activation | 407 ;;;_ #1 Internal Outline Formatting and Configuration |
408 ;;;_ - Version | |
409 ;;;_ = outline-version | |
410 (defvar outline-version | |
411 (let ((rcs-rev "$Revision: 4.1 $")) | |
412 (condition-case err | |
413 (save-match-data | |
414 (string-match "\\$Revision: \\([0-9]+\\.[0-9]+\\)" rcs-rev) | |
415 (substring rcs-rev (match-beginning 1) (match-end 1))) | |
416 (error rcs-rev))) | |
417 "Revision number of currently loaded outline package. (Currently | |
418 specific to allout.el.)") | |
419 ;;;_ > outline-version | |
420 (defun outline-version (&optional here) | |
421 "Return string describing the loaded outline version." | |
422 (interactive "P") | |
423 (let ((msg (concat "Allout Outline Mode v " outline-version))) | |
424 (if here (insert-string msg)) | |
425 (message "%s" msg) | |
426 msg)) | |
311 ;;;_ - Topic header format | 427 ;;;_ - Topic header format |
312 ;;;_ = outline-regexp | 428 ;;;_ = outline-regexp |
313 (defvar outline-regexp "" | 429 (defvar outline-regexp "" |
314 "*Regular expression to match the beginning of a heading line. | 430 "*Regular expression to match the beginning of a heading line. |
431 | |
315 Any line whose beginning matches this regexp is considered a | 432 Any line whose beginning matches this regexp is considered a |
316 heading. This var is set according to the user configuration vars | 433 heading. This var is set according to the user configuration vars |
317 by set-outline-regexp.") | 434 by set-outline-regexp.") |
318 (make-variable-buffer-local 'outline-regexp) | 435 (make-variable-buffer-local 'outline-regexp) |
319 ;;;_ = outline-bullets-string | 436 ;;;_ = outline-bullets-string |
320 (defvar outline-bullets-string "" | 437 (defvar outline-bullets-string "" |
321 "A string dictating the valid set of outline topic bullets. This | 438 "A string dictating the valid set of outline topic bullets. |
322 var should *not* be set by the user - it is set by 'set-outline-regexp', | 439 |
323 and is composed from the elements of 'outline-plain-bullets-string' | 440 This var should *not* be set by the user - it is set by 'set-outline-regexp', |
441 and is produced from the elements of 'outline-plain-bullets-string' | |
324 and 'outline-distinctive-bullets-string'.") | 442 and 'outline-distinctive-bullets-string'.") |
325 (make-variable-buffer-local 'outline-bullets-string) | 443 (make-variable-buffer-local 'outline-bullets-string) |
326 ;;;_ = outline-bullets-string-len | 444 ;;;_ = outline-bullets-string-len |
327 (defvar outline-bullets-string-len 0 | 445 (defvar outline-bullets-string-len 0 |
328 "Length of current buffers' outline-plain-bullets-string.") | 446 "Length of current buffers' outline-plain-bullets-string.") |
329 (make-variable-buffer-local 'outline-bullets-string-len) | 447 (make-variable-buffer-local 'outline-bullets-string-len) |
330 ;;;_ = outline-line-boundary-regexp | 448 ;;;_ = outline-line-boundary-regexp |
331 (defvar outline-line-boundary-regexp () | 449 (defvar outline-line-boundary-regexp () |
332 "outline-regexp with outline-style beginning of line anchor (ie, | 450 "Outline-regexp with outline-style beginning-of-line anchor. |
333 C-j, *or* C-m, for prefixes of hidden topics). This is properly | 451 |
452 (Ie, C-j, *or* C-m, for prefixes of hidden topics). This is properly | |
334 set when outline-regexp is produced by 'set-outline-regexp', so | 453 set when outline-regexp is produced by 'set-outline-regexp', so |
335 that (match-beginning 2) and (match-end 2) delimit the prefix.") | 454 that (match-beginning 2) and (match-end 2) delimit the prefix.") |
336 (make-variable-buffer-local 'outline-line-boundary-regexp) | 455 (make-variable-buffer-local 'outline-line-boundary-regexp) |
337 ;;;_ = outline-bob-regexp | 456 ;;;_ = outline-bob-regexp |
338 (defvar outline-bob-regexp () | 457 (defvar outline-bob-regexp () |
339 "Like outline-line-boundary-regexp, this is an outline-regexp for | 458 "Like outline-line-boundary-regexp, for headers at beginning of buffer. |
340 outline headers at the beginning of the buffer. (match-beginning 2) | 459 (match-beginning 2) and (match-end 2) delimit the prefix.") |
341 and (match-end 2) delimit the prefix.") | |
342 (make-variable-buffer-local 'outline-bob-regexp) | 460 (make-variable-buffer-local 'outline-bob-regexp) |
343 ;;;_ = current-bullet | |
344 (defvar current-bullet nil | |
345 "Variable local to outline-rebullet-heading,but referenced by | |
346 outline-make-topic-prefix, also. Should be resolved with explicitly | |
347 parameterized communication between the two, if suitable.") | |
348 ;;;_ = outline-header-subtraction | 461 ;;;_ = outline-header-subtraction |
349 (defvar outline-header-subtraction (1- (length outline-header-prefix)) | 462 (defvar outline-header-subtraction (1- (length outline-header-prefix)) |
350 "Length of outline-header prefix to subtract when computing depth | 463 "Outline-header prefix length to subtract when computing topic depth.") |
351 from prefix length.") | |
352 (make-variable-buffer-local 'outline-header-subtraction) | 464 (make-variable-buffer-local 'outline-header-subtraction) |
353 ;;;_ = outline-plain-bullets-string-len | 465 ;;;_ = outline-plain-bullets-string-len |
354 (defvar outline-plain-bullets-string-len (length outline-plain-bullets-string) | 466 (defvar outline-plain-bullets-string-len (length outline-plain-bullets-string) |
355 "Length of outline-plain-bullets-string, updated by set-outline-regexp.") | 467 "Length of outline-plain-bullets-string, updated by set-outline-regexp.") |
356 (make-variable-buffer-local 'outline-plain-bullets-string-len) | 468 (make-variable-buffer-local 'outline-plain-bullets-string-len) |
363 (setq outline-header-prefix header-lead) | 475 (setq outline-header-prefix header-lead) |
364 (setq outline-header-subtraction (1- (length outline-header-prefix))) | 476 (setq outline-header-subtraction (1- (length outline-header-prefix))) |
365 (set-outline-regexp)) | 477 (set-outline-regexp)) |
366 ;;;_ > outline-lead-with-comment-string (header-lead) | 478 ;;;_ > outline-lead-with-comment-string (header-lead) |
367 (defun outline-lead-with-comment-string (&optional header-lead) | 479 (defun outline-lead-with-comment-string (&optional header-lead) |
368 "*Set the topic-header leading string to specified string. Useful | 480 "*Set the topic-header leading string to specified string. |
369 when for encapsulating outline structure in programming language | 481 |
370 comments. Returns the leading string." | 482 Useful when for encapsulating outline structure in programming |
483 language comments. Returns the leading string." | |
371 | 484 |
372 (interactive "P") | 485 (interactive "P") |
373 (if (not (stringp header-lead)) | 486 (if (not (stringp header-lead)) |
374 (setq header-lead (read-string | 487 (setq header-lead (read-string |
375 "String prefix for topic headers: "))) | 488 "String prefix for topic headers: "))) |
376 (setq outline-reindent-bodies nil) | 489 (setq outline-reindent-bodies nil) |
377 (outline-reset-header-lead header-lead) | 490 (outline-reset-header-lead header-lead) |
378 header-lead) | 491 header-lead) |
492 ;;;_ > outline-infer-header-lead (&optional reset) | |
493 (defun outline-infer-header-lead (&optional set) | |
494 "Determine appropriate `outline-header-prefix'. | |
495 | |
496 Works according to settings of: | |
497 | |
498 `outline-header-prefix' (default) | |
499 `outline-use-mode-specific-leader' | |
500 and `outline-mode-leaders'. | |
501 | |
502 Optional arg SET means to do the processing to establish that prefix | |
503 for current outline processing, if it has changed from prior setting." | |
504 (let* ((use-leader (and (boundp 'outline-use-mode-specific-leader) | |
505 (if (or (stringp outline-use-mode-specific-leader) | |
506 (memq outline-use-mode-specific-leader | |
507 '(outline-mode-leaders | |
508 comment-start | |
509 t))) | |
510 outline-use-mode-specific-leader | |
511 ;; Oops - garbled value, equate with effect of 't: | |
512 t))) | |
513 (leader | |
514 (cond | |
515 ((not use-leader) nil) | |
516 ;; Use the explicitly designated leader: | |
517 ((stringp use-leader) use-leader) | |
518 (t (or (and (memq use-leader '(t outline-mode-leaders)) | |
519 ;; Get it from outline mode leaders? | |
520 (cdr (assq major-mode outline-mode-leaders))) | |
521 ;; ... didn't get from outline-mode-leaders... | |
522 (and (memq use-leader '(t comment-start)) | |
523 comment-start | |
524 ;; Use comment-start, maybe tripled, and with | |
525 ;; underscore: | |
526 (concat | |
527 (if (string= " " | |
528 (substring comment-start | |
529 (1- (length comment-start)))) | |
530 ;; Use comment-start, sans trailing space: | |
531 (substring comment-start 0 -1) | |
532 (concat comment-start comment-start comment-start)) | |
533 ;; ... and append underscore, whichever: | |
534 "_"))))))) | |
535 (if (not leader) | |
536 nil | |
537 (if (string= leader outline-header-prefix) | |
538 nil ; no change, nothing to do. | |
539 (setq outline-header-prefix leader) | |
540 (if set (outline-reset-header-lead outline-header-prefix)) | |
541 outline-header-prefix)))) | |
379 ;;;_ > set-outline-regexp () | 542 ;;;_ > set-outline-regexp () |
380 (defun set-outline-regexp () | 543 (defun set-outline-regexp () |
381 "Generate proper topic-header regexp form for outline functions, from | 544 "Generate proper topic-header regexp form for outline functions. |
382 outline-plain-bullets-string and outline-distinctive-bullets-string." | 545 |
546 Works with respect to `outline-plain-bullets-string' and | |
547 `outline-distinctive-bullets-string'." | |
383 | 548 |
384 (interactive) | 549 (interactive) |
385 ;; Derive outline-bullets-string from user configured components: | 550 ;; Derive outline-bullets-string from user configured components: |
386 (setq outline-bullets-string "") | 551 (setq outline-bullets-string "") |
387 (let ((strings (list 'outline-plain-bullets-string | 552 (let ((strings (list 'outline-plain-bullets-string |
427 (concat "\\([\n\r]\\)\\(" outline-regexp "\\)")) | 592 (concat "\\([\n\r]\\)\\(" outline-regexp "\\)")) |
428 (setq outline-bob-regexp | 593 (setq outline-bob-regexp |
429 (concat "\\(\\`\\)\\(" outline-regexp "\\)")) | 594 (concat "\\(\\`\\)\\(" outline-regexp "\\)")) |
430 ) | 595 ) |
431 ;;;_ - Key bindings | 596 ;;;_ - Key bindings |
432 ;;;_ = outline-prior-bindings | 597 ;;;_ = outline-mode-map |
598 (defvar outline-mode-map nil "Keybindings for (allout) outline minor mode.") | |
599 ;;;_ > produce-outline-mode-map (keymap-alist &optional base-map) | |
600 (defun produce-outline-mode-map (keymap-list &optional base-map) | |
601 "Produce keymap for use as outline-mode-map, from keymap-list. | |
602 | |
603 Built on top of optional BASE-MAP, or empty sparse map if none specified. | |
604 See doc string for outline-keybindings-list for format of binding list." | |
605 (let ((map (or base-map (make-sparse-keymap)))) | |
606 (mapcar (lambda (cell) | |
607 (apply 'define-key map (if (null (cdr (cdr cell))) | |
608 (cons (concat outline-command-prefix | |
609 (car cell)) | |
610 (cdr cell)) | |
611 (list (car cell) (car (cdr cell)))))) | |
612 keymap-list) | |
613 map)) | |
614 ;;;_ = outline-prior-bindings - being deprecated. | |
433 (defvar outline-prior-bindings nil | 615 (defvar outline-prior-bindings nil |
434 "Variable for use in V18, with outline-added-bindings, for | 616 "Variable for use in V18, with outline-added-bindings, for |
435 resurrecting, on mode deactivation, bindings that existed before | 617 resurrecting, on mode deactivation, bindings that existed before |
436 activation.") | 618 activation. Being deprecated.") |
437 ;;;_ = outline-added-bindings | 619 ;;;_ = outline-added-bindings - being deprecated |
438 (defvar outline-added-bindings nil | 620 (defvar outline-added-bindings nil |
439 "Variable for use in V18, with outline-prior-bindings, for | 621 "Variable for use in V18, with outline-prior-bindings, for |
440 resurrecting, on mode deactivation, bindings that existed before | 622 resurrecting, on mode deactivation, bindings that existed before |
441 activation.") | 623 activation. Being deprecated.") |
442 ;;;_ - Mode-Specific Variable Maintenance Utilities | 624 ;;;_ - Mode-Specific Variable Maintenance Utilities |
443 ;;;_ = outline-mode-prior-settings | 625 ;;;_ = outline-mode-prior-settings |
444 (defvar outline-mode-prior-settings nil | 626 (defvar outline-mode-prior-settings nil |
445 "For internal use by outline mode, registers settings to be resumed | 627 "Internal outline mode use; settings to be resumed on mode deactivation.") |
446 on mode deactivation.") | |
447 (make-variable-buffer-local 'outline-mode-prior-settings) | 628 (make-variable-buffer-local 'outline-mode-prior-settings) |
448 ;;;_ > outline-resumptions (name &optional value) | 629 ;;;_ > outline-resumptions (name &optional value) |
449 (defun outline-resumptions (name &optional value) | 630 (defun outline-resumptions (name &optional value) |
450 | 631 |
451 "Registers information for later reference, or performs resumption of | 632 "Registers or resumes settings over outline-mode activation/deactivation. |
452 outline-mode specific values. First arg is NAME of variable affected. | 633 |
453 optional second arg is list containing outline-mode-specific VALUE to | 634 First arg is NAME of variable affected. Optional second arg is list |
454 be imposed on named variable, and to be registered. (It's a list so you | 635 containing outline-mode-specific VALUE to be imposed on named |
455 can specify registrations of null values.) If no value is specified, | 636 variable, and to be registered. (It's a list so you can specify |
456 the registered value is returned (encapsulated in the list, so the | 637 registrations of null values.) If no value is specified, the |
457 caller can distinguish nil vs no value), and the registration is popped | 638 registered value is returned (encapsulated in the list, so the caller |
639 can distinguish nil vs no value), and the registration is popped | |
458 from the list." | 640 from the list." |
459 | 641 |
460 (let ((on-list (assq name outline-mode-prior-settings)) | 642 (let ((on-list (assq name outline-mode-prior-settings)) |
461 prior-capsule ; By 'capsule' i mean a list | 643 prior-capsule ; By 'capsule' i mean a list |
462 ; containing a value, so we can | 644 ; containing a value, so we can |
500 rebuild))) | 682 rebuild))) |
501 (setq outline-mode-prior-settings | 683 (setq outline-mode-prior-settings |
502 (cdr outline-mode-prior-settings))) | 684 (cdr outline-mode-prior-settings))) |
503 (setq outline-mode-prior-settings rebuild))))) | 685 (setq outline-mode-prior-settings rebuild))))) |
504 ) | 686 ) |
505 ;;;_ - Version | 687 ;;;_ - Mode-specific incidentals |
506 ;;;_ = outline-version | |
507 (defvar outline-version | |
508 (let ((rcs-rev "$Revision: 3.39 $")) | |
509 (condition-case err | |
510 (save-match-data | |
511 (string-match "\\$Revision: \\([0-9]+\\.[0-9]+\\)" rcs-rev) | |
512 (substring rcs-rev (match-beginning 1) (match-end 1))) | |
513 (error rcs-rev))) | |
514 "Revision number of currently loaded outline package. (Currently | |
515 specific to allout.el.)") | |
516 ;;;_ > outline-version | |
517 (defun outline-version (&optional here) | |
518 "Return string describing the loaded outline version." | |
519 (interactive "P") | |
520 (let ((msg (concat "Allout Outline Mode v " outline-version))) | |
521 (if here (insert-string msg)) | |
522 (message "%s" msg) | |
523 msg)) | |
524 | |
525 ;;;_ - Mode activation | |
526 ;;;_ = outline-mode | |
527 (defvar outline-mode () "Allout outline mode minor-mode flag.") | |
528 (make-variable-buffer-local 'outline-mode) | |
529 ;;;_ = outline-mode-map | |
530 (defvar outline-mode-map nil "Keybindings for (allout) outline minor mode.") | |
531 ;;;_ > outline-mode-p () | |
532 (defmacro outline-mode-p () | |
533 '(and (boundp 'outline-mode) outline-mode)) | |
534 | |
535 ;;;_ = outline-during-write-cue nil | 688 ;;;_ = outline-during-write-cue nil |
536 (defvar outline-during-write-cue nil | 689 (defvar outline-during-write-cue nil |
537 "Indication, for outline-post-command-business, that we are in the | 690 "Used to inhibit outline change-protection during file write. |
538 process of writing a file, and need to inhibit change protection. See | 691 |
539 also, outline-write-file-hook, outline-before-change-protect, | 692 See also `outline-post-command-business', `outline-write-file-hook', |
540 outline-post-command-business functions.") | 693 `outline-before-change-protect', and `outline-post-command-business' |
541 | 694 functions.") |
542 ;;;_ > outline-write-file-hook () | |
543 (defun outline-write-file-hook () | |
544 "In outline mode, run as a local-write-file-hooks activity. | |
545 Currently just sets 'outline-during-write-cue', so outline-change- | |
546 protection knows to keep inactive during file write." | |
547 (setq outline-during-write-cue t) | |
548 nil) | |
549 | |
550 ;;;_ = outline-override-protect nil | 695 ;;;_ = outline-override-protect nil |
551 (defvar outline-override-protect nil | 696 (defvar outline-override-protect nil |
552 "In emacs v19 &c, outline-allout mode regulates alteration of concealed text | 697 "Used in outline-mode for regulate of concealed-text protection mechanism. |
553 so it's affected as a unit, or not at all. This is for use by competant | 698 |
554 (eg, native outline) functions to temporarily override that protection. It's | 699 Allout outline mode regulates alteration of concealed text to protect |
555 automatically reset to nil after every buffer modification.") | 700 against inadvertant, unnoticed changes. This is for use by specific, |
701 native outline functions to temporarily override that protection. | |
702 It's automatically reset to nil after every buffer modification.") | |
556 (make-variable-buffer-local 'outline-override-protect) | 703 (make-variable-buffer-local 'outline-override-protect) |
557 ;;;_ > outline-unprotected (expr) | 704 ;;;_ > outline-unprotected (expr) |
558 (defmacro outline-unprotected (expr) | 705 (defmacro outline-unprotected (expr) |
559 "Evaluate EXPRESSION with outline-override-protect | 706 "Evaluate EXPRESSION with `outline-override-protect' let-bound 't'." |
560 let-bound 't'." | |
561 (` (let ((outline-override-protect t)) | 707 (` (let ((outline-override-protect t)) |
562 (, expr)))) | 708 (, expr)))) |
563 ;;;_ = outline-undo-aggregation | 709 ;;;_ = outline-undo-aggregation |
564 (defvar outline-undo-aggregation 30 | 710 (defvar outline-undo-aggregation 30 |
565 "Amount of successive self-insert actions to bunch together per undo. | 711 "Amount of successive self-insert actions to bunch together per undo. |
712 | |
566 This is purely a kludge variable, regulating the compensation for a bug in | 713 This is purely a kludge variable, regulating the compensation for a bug in |
567 the way that before-change-function and undo interact.") | 714 the way that before-change-function and undo interact.") |
568 (make-variable-buffer-local 'outline-undo-aggregation) | 715 (make-variable-buffer-local 'outline-undo-aggregation) |
569 | 716 ;;;_ = file-var-bug hack |
570 ;;;_ > produce-outline-mode-map (keymap-alist &optional base-map) | |
571 (defun produce-outline-mode-map (keymap-list &optional base-map) | |
572 "Produce keymap for use as outline-mode-map, from keymap-list. | |
573 Built on top of optional BASE-MAP, or empty sparse map if none specified. | |
574 See doc string for outline-keybindings-list for format of binding list." | |
575 (let ((map (or base-map (make-sparse-keymap)))) | |
576 (mapcar (lambda (cell) | |
577 (apply 'define-key map (if (null (cdr (cdr cell))) | |
578 (cons (concat outline-command-prefix | |
579 (car cell)) | |
580 (cdr cell)) | |
581 (list (car cell) (car (cdr cell)))))) | |
582 keymap-list) | |
583 map)) | |
584 ;;;_ > outline-mode (&optional toggle) | |
585 ;;;_ . Defun: | |
586 (defvar outline-v18/9-file-var-hack nil | 717 (defvar outline-v18/9-file-var-hack nil |
587 "Horrible hack used to prevent invalid multiple triggering of outline | 718 "Horrible hack used to prevent invalid multiple triggering of outline |
588 mode from prop-line file-var activation. Used by outline-mode function | 719 mode from prop-line file-var activation. Used by outline-mode function |
589 to track repeats.") | 720 to track repeats.") |
721 ;;;_ > outline-write-file-hook () | |
722 (defun outline-write-file-hook () | |
723 "In outline mode, run as a local-write-file-hooks activity. | |
724 | |
725 Currently just sets 'outline-during-write-cue', so outline-change- | |
726 protection knows to keep inactive during file write." | |
727 (setq outline-during-write-cue t) | |
728 nil) | |
729 | |
730 ;;;_ #2 Mode activation | |
731 ;;;_ = outline-mode | |
732 (defvar outline-mode () "Allout outline mode minor-mode flag.") | |
733 (make-variable-buffer-local 'outline-mode) | |
734 ;;;_ > outline-mode-p () | |
735 (defmacro outline-mode-p () | |
736 "Return t if outline-mode is active in current buffer." | |
737 'outline-mode) | |
738 ;;;_ = outline-explicitly-deactivated | |
739 (defvar outline-explicitly-deactivated nil | |
740 "Outline-mode was last deliberately deactived. | |
741 So outline-post-command-business should not reactivate it...") | |
742 (make-variable-buffer-local 'outline-explicitly-deactivated) | |
743 ;;;_ > outline-init (mode) | |
744 (defun outline-init (mode) | |
745 "Prime outline-mode to enable/disable auto-activation, wrt `outline-layout'. | |
746 | |
747 MODE is one of: | |
748 | |
749 - nil, for no auto-activation, | |
750 - `activation', for auto-activation only, | |
751 - `ask' for auto-activation and auto-layout on confirmation from user, | |
752 - anything else, for auto-activation and auto-layout, without any | |
753 confirmation check. | |
754 | |
755 Use this function to setup your emacs session for automatic activation | |
756 of allout outline mode, contingent to the buffer-specific setting of | |
757 the `outline-layout' variable. (See `outline-layout' and | |
758 `outline-expose-topic' docstrings for more details on auto layout). | |
759 | |
760 `outline-init' works by setting up (or removing) the outline-mode | |
761 find-file-hook, and giving `outline-auto-activation' a suitable | |
762 setting. | |
763 | |
764 To prime your emacs session for full auto-outline operation, include | |
765 the following two lines in your emacs init file: | |
766 | |
767 \(require 'allout) | |
768 \(outline-init t)" | |
769 | |
770 (if (not mode) | |
771 (progn | |
772 (setq find-file-hooks (delq 'outline-find-file-hook find-file-hooks)) | |
773 (if (interactive-p) | |
774 (message "Allout outline mode auto-activation inhibited."))) | |
775 (add-hook 'find-file-hooks 'outline-find-file-hook) | |
776 (setq outline-auto-activation | |
777 (cond ((eq mode 'activation) | |
778 (message "Allout outline mode auto-activation enabled.") | |
779 'activate) | |
780 ((eq mode 'ask) | |
781 (message "Allout outline mode auto-activation enabled.") | |
782 'ask) | |
783 ((message | |
784 "Allout outline mode auto-activation and -layout enabled.") | |
785 t))) | |
786 | |
787 t))))) | |
788 ;;;_ > outline-mode (&optional toggle) | |
789 ;;;_ : Defun: | |
590 (defun outline-mode (&optional toggle) | 790 (defun outline-mode (&optional toggle) |
591 ;;;_ . Doc string: | 791 ;;;_ . Doc string: |
592 "Toggle minor mode for controlling exposure of and editing text | 792 "Toggle minor mode for controlling exposure and editing of text outlines. |
593 outlines. Optional arg forces mode activation iff arg is positive. | 793 |
594 | 794 Optional arg forces mode reactivation iff arg is positive num or symbol. |
595 Look below the description of the bindings for explanation of the | 795 |
596 terminology use in outline-mode commands. | 796 Allout outline mode provides extensive outline formatting and |
597 | 797 manipulation capabilities. It is specifically aimed at supporting |
598 Exposure Commands Movement Commands | 798 outline structuring and manipulation of syntax-sensitive text, eg |
599 C-c C-h outline-hide-current-subtree C-c C-n outline-next-visible-heading | 799 programming languages. \(For an example, see the allout code itself, |
600 C-c C-i outline-show-children C-c C-p outline-previous-visible-heading | 800 which is organized in outline structure.\) |
601 C-c C-s outline-show-current-subtree C-c C-u outline-up-current-level | 801 |
602 C-c C-o outline-show-current-entry C-c C-f outline-forward-current-level | 802 It also includes such things as topic-oriented repositioning, cut, and |
603 C-c ! outline-show-all C-c C-b outline-backward-current-level | 803 paste; integral outline exposure-layout; incremental search with |
604 outline-hide-current-leaves C-c C-e outline-end-of-current-entry | 804 dynamic exposure/conceament of concealed text; automatic topic-number |
605 C-c C-a outline-beginning-of-current-entry | 805 maintenance; and many other features. |
606 | 806 |
607 | 807 See the docstring of the variable `outline-init' for instructions on |
608 Topic Header Generation Commands | 808 priming your emacs session for automatic activation of outline-mode, |
609 C-c<SP> outline-open-sibtopic Create a new sibling after current topic | 809 according to file-var settings of the `outline-layout' variable. |
610 C-c . outline-open-subtopic ... an offspring of current topic | 810 |
611 C-c , outline-open-supertopic ... a sibling of the current topics' parent | 811 Below is a description of the bindings, and then explanation of |
612 | 812 special outline-mode features and terminology. |
613 Level and Prefix Adjustment Commands | 813 |
614 C-c > outline-shift-in Shift current topic and all offspring deeper | 814 The bindings themselves are established according to the values of |
615 C-c < outline-shift-out ... less deep | 815 variables `outline-keybindings-list' and `outline-command-prefix', |
616 C-c<CR> outline-rebullet-topic Reconcile bullets of topic and its offspring | 816 each time the mode is invoked. Prior bindings are resurrected when |
617 - distinctive bullets are not changed, all | 817 the mode is revoked. |
618 others set suitable according to depth | 818 |
819 Navigation: Exposure Control: | |
820 ---------- ---------------- | |
821 C-c C-n outline-next-visible-heading | C-c C-h outline-hide-current-subtree | |
822 C-c C-p outline-previous-visible-heading | C-c C-i outline-show-children | |
823 C-c C-u outline-up-current-level | C-c C-s outline-show-current-subtree | |
824 C-c C-f outline-forward-current-level | C-c C-o outline-show-current-entry | |
825 C-c C-b outline-backward-current-level | ^U C-c C-s outline-show-all | |
826 C-c C-e outline-end-of-current-entry | outline-hide-current-leaves | |
827 C-c C-a outline-beginning-of-current-entry, alternately, goes to hot-spot | |
828 | |
829 Topic Header Production: | |
830 ----------------------- | |
831 C-c<SP> outline-open-sibtopic Create a new sibling after current topic. | |
832 C-c . outline-open-subtopic ... an offspring of current topic. | |
833 C-c , outline-open-supertopic ... a sibling of the current topic's parent. | |
834 | |
835 Topic Level and Prefix Adjustment: | |
836 --------------------------------- | |
837 C-c > outline-shift-in Shift current topic and all offspring deeper. | |
838 C-c < outline-shift-out ... less deep. | |
839 C-c<CR> outline-rebullet-topic Reconcile bullets of topic and its' offspring | |
840 - distinctive bullets are not changed, others | |
841 alternated according to nesting depth. | |
619 C-c b outline-rebullet-current-heading Prompt for alternate bullet for | 842 C-c b outline-rebullet-current-heading Prompt for alternate bullet for |
620 current topic | 843 current topic. |
621 C-c # outline-number-siblings Number bullets of topic and siblings - the | 844 C-c # outline-number-siblings Number bullets of topic and siblings - the |
622 offspring are not affected. With repeat | 845 offspring are not affected. With repeat |
623 count, revoke numbering. | 846 count, revoke numbering. |
624 | 847 |
625 Killing and Yanking - all keep siblings numbering reconciled as appropriate | 848 Topic-oriented Killing and Yanking: |
626 C-k outline-kill-line Regular kill line, but respects numbering ,etc | 849 ---------------------------------- |
627 C-c C-k outline-kill-topic Kill current topic, including offspring | 850 C-c C-k outline-kill-topic Kill current topic, including offspring. |
851 C-k outline-kill-line Like kill-line, but reconciles numbering, etc. | |
628 C-y outline-yank Yank, adjusting depth of yanked topic to | 852 C-y outline-yank Yank, adjusting depth of yanked topic to |
629 depth of heading if yanking into bare topic | 853 depth of heading if yanking into bare topic |
630 heading (ie, prefix sans text) | 854 heading (ie, prefix sans text). |
631 M-y outline-yank-pop Is to outline-yank as yank-pop is to yank | 855 M-y outline-yank-pop Is to outline-yank as yank-pop is to yank |
632 | 856 |
633 Misc commands | 857 Misc commands: |
858 ------------- | |
634 C-c @ outline-resolve-xref pop-to-buffer named by xref (cf | 859 C-c @ outline-resolve-xref pop-to-buffer named by xref (cf |
635 outline-file-xref-bullet) | 860 outline-file-xref-bullet) |
636 C-c c outline-copy-exposed Copy outline sans all hidden stuff to | 861 C-c c outline-copy-exposed Copy current topic outline sans concealed |
637 another buffer whose name is derived | 862 text, to buffer with name derived from |
638 from the current one - \"XXX exposed\" | 863 current buffer - \"XXX exposed\" |
639 M-x outlineify-sticky Activate outline mode for current buffer | 864 M-x outlineify-sticky Activate outline mode for current buffer, |
640 and establish -*- outline -*- mode specifier | 865 and establish a default file-var setting |
641 as well as file local vars to automatically | 866 for `outline-layout'. |
642 set exposure. Try it. | 867 ESC ESC (outline-init t) Setup emacs session for outline mode |
868 auto-activation. | |
869 | |
870 HOT-SPOT Operation | |
871 | |
872 Hot-spot operation provides a means for easy, single-keystroke outline | |
873 navigation and exposure control. | |
643 | 874 |
644 \\<outline-mode-map> | 875 \\<outline-mode-map> |
645 HOT-SPOT Operation (Not available in Emacs v18.) | 876 When the text cursor is positioned directly on the bullet character of |
646 | 877 a topic, regular characters (a to z) invoke the commands of the |
647 Hot-spot operation enables succinct outline operation. When the | 878 corresponding outline-mode keymap control chars. For example, \"f\" |
648 cursor is located on the bullet character of a topic, literal | 879 would invoke the command typically bound to \"C-c C-f\" |
649 characters invoke the commands of the corresponding control chars in | 880 \(\\[outline-forward-current-level] `outline-forward-current-level'). |
650 the outline-mode keymap. Thus, 'f' would invoke the command bound to | 881 |
651 <outline-command-prefix>-\C-f \(typically 'outline-forward-current- | 882 Thus, by positioning the cursor on a topic bullet, you can execute |
652 level'). | |
653 | |
654 Thus, by positioning the cursor on a topic bullet, you can do each of | |
655 the outline navigation and manipulation commands with a single | 883 the outline navigation and manipulation commands with a single |
656 keystroke. Non-literal char do not get this special interpretation, | 884 keystroke. Non-literal chars never get this special translation, so |
657 even on the hot-spot, so you can use them to get off of it, and back | 885 you can use them to get away from the hot-spot, and back to normal |
658 to normal operation. | 886 operation. |
659 | 887 |
660 Note that the command outline-beginning-of-current-entry \(\\[outline-beginning-of-current-entry]\) | 888 Note that the command `outline-beginning-of-current-entry' \(\\[outline-beginning-of-current-entry]\) |
661 will move to the hot-spot when the cursor is already located at the | 889 will move to the hot-spot when the cursor is already located at the |
662 beginning of the current entry, so you can simply hit \\[outline-beginning-of-current-entry] | 890 beginning of the current entry, so you can simply hit \\[outline-beginning-of-current-entry] |
663 twice in a row to get to the hot-spot. | 891 twice in a row to get to the hot-spot. |
664 | 892 |
665 Terminology | 893 Terminology |
666 | 894 |
667 Topic hierarchy constituents - TOPICS and SUBTOPICS: | 895 Topic hierarchy constituents - TOPICS and SUBTOPICS: |
668 | 896 |
669 TOPIC: A basic, coherent component of an emacs outline. It can | 897 TOPIC: A basic, coherent component of an emacs outline. It can |
670 contain other topics, and it can be subsumed by other topics, | 898 contain other topics, and it can be subsumed by other topics, |
671 CURRENT topic: | 899 CURRENT topic: |
672 The visible topic most immediately containing the cursor. | 900 The visible topic most immediately containing the cursor. |
673 DEPTH: The degree of nesting of a topic, it increases with | 901 DEPTH: The degree of nesting of a topic; it increases with |
674 containment. Also called the | 902 containment. Also called the: |
675 LEVEL: The same as DEPTH. | 903 LEVEL: The same as DEPTH. |
676 | 904 |
677 ANCESTORS: | 905 ANCESTORS: |
678 The topics that contain a topic. | 906 The topics that contain a topic. |
679 PARENT: A topic's immediate ancestor. It has a depth one less than | 907 PARENT: A topic's immediate ancestor. It has a depth one less than |
680 the topic. | 908 the topic. |
681 OFFSPRING: | 909 OFFSPRING: |
682 The topics contained by a topic, | 910 The topics contained by a topic; |
911 SUBTOPIC: | |
912 An immediate offspring of a topic; | |
683 CHILDREN: | 913 CHILDREN: |
684 The immediate offspring of a topic. | 914 The immediate offspring of a topic. |
685 SIBLINGS: | 915 SIBLINGS: |
686 Topics having the same parent. | 916 Topics having the same parent and depth. |
687 | 917 |
688 Topic text constituents: | 918 Topic text constituents: |
689 | 919 |
690 HEADER: The first line of a topic, include the topic PREFIX and header | 920 HEADER: The first line of a topic, include the topic PREFIX and header |
691 text. | 921 text. |
692 PREFIX: The leading text of a topic which which distinguishes it from | 922 PREFIX: The leading text of a topic which which distinguishes it from |
698 The relative length of the PREFIX determines the nesting depth | 928 The relative length of the PREFIX determines the nesting depth |
699 of the topic. | 929 of the topic. |
700 PREFIX-LEAD: | 930 PREFIX-LEAD: |
701 The string at the beginning of a topic prefix, normally a '.'. | 931 The string at the beginning of a topic prefix, normally a '.'. |
702 It can be customized by changing the setting of | 932 It can be customized by changing the setting of |
703 'outline-header-prefix' and then reinitializing outline-mode. | 933 `outline-header-prefix' and then reinitializing outline-mode. |
704 | 934 |
705 By setting the prefix-lead to the comment-string of a | 935 By setting the prefix-lead to the comment-string of a |
706 programming language, you can embed outline-structuring in | 936 programming language, you can embed outline-structuring in |
707 program code without interfering with the language processing | 937 program code without interfering with the language processing |
708 of that code. | 938 of that code. See `outline-use-mode-specific-leader' |
939 docstring for more detail. | |
709 PREFIX-PADDING: | 940 PREFIX-PADDING: |
710 Spaces or asterisks which separate the prefix-lead and the | 941 Spaces or asterisks which separate the prefix-lead and the |
711 bullet, according to the depth of the topic. | 942 bullet, according to the depth of the topic. |
712 BULLET: A character at the end of the topic prefix, it must be one of | 943 BULLET: A character at the end of the topic prefix, it must be one of |
713 the characters listed on 'outline-plain-bullets-string' or | 944 the characters listed on 'outline-plain-bullets-string' or |
727 units of concealed text is represented by '...' ellipses. | 958 units of concealed text is represented by '...' ellipses. |
728 (Ref the 'selective-display' var.) | 959 (Ref the 'selective-display' var.) |
729 | 960 |
730 Concealed topics are effectively collapsed within an ancestor. | 961 Concealed topics are effectively collapsed within an ancestor. |
731 CLOSED: A topic whose immediate offspring and body-text is concealed. | 962 CLOSED: A topic whose immediate offspring and body-text is concealed. |
732 OPEN: A topic that is not closed." | 963 OPEN: A topic that is not closed, though its' offspring or body may be." |
733 | |
734 ;;;_ . Code | 964 ;;;_ . Code |
735 (interactive "P") | 965 (interactive "P") |
736 | 966 |
737 (let* ((active (and (not (equal major-mode 'outline)) | 967 (let* ((active (and (not (equal major-mode 'outline)) |
738 (outline-mode-p))) | 968 (outline-mode-p))) |
739 ; Massage universal-arg 'toggle' val: | 969 ; Massage universal-arg 'toggle' val: |
740 (toggle (and toggle | 970 (toggle (and toggle |
741 (or (and (listp toggle)(car toggle)) | 971 (or (and (listp toggle)(car toggle)) |
742 toggle))) | 972 toggle))) |
743 ; Activation specficially demanded? | 973 ; Activation specficially demanded? |
744 (explicit-activation (or | 974 (explicit-activation (or |
745 ;; | 975 ;; |
746 (and toggle | 976 (and toggle |
747 (or (symbolp toggle) | 977 (or (symbolp toggle) |
748 (and (natnump toggle) | 978 (and (natnump toggle) |
749 (not (zerop toggle))))))) | 979 (not (zerop toggle))))))) |
750 ;; outline-mode already called once during this complex command? | 980 ;; outline-mode already called once during this complex command? |
751 (same-complex-command (eq outline-v18/9-file-var-hack | 981 (same-complex-command (eq outline-v18/9-file-var-hack |
752 (car command-history)))) | 982 (car command-history))) |
753 | 983 do-layout |
754 ; See comments below re v19.18,.19 bug. | 984 ) |
985 | |
986 ; See comments below re v19.18,.19 bug. | |
755 (setq outline-v18/9-file-var-hack (car command-history)) | 987 (setq outline-v18/9-file-var-hack (car command-history)) |
756 | 988 |
757 (cond | 989 (cond |
758 | 990 |
759 ;; Hitting v19.18, 19.19 bug? | 991 ;; Provision for v19.18, 19.19 bug - |
760 ;; Emacs v 19.18, 19.19 file-var code invokes prop-line-designated | 992 ;; Emacs v 19.18, 19.19 file-var code invokes prop-line-designated |
761 ;; modes twice when file is visited. We have to avoid toggling mode | 993 ;; modes twice when file is visited. We have to avoid toggling mode |
762 ;; off on second invocation, so we detect it as best we can, and | 994 ;; off on second invocation, so we detect it as best we can, and |
763 ;; skip everything. | 995 ;; skip everything. |
764 ((and same-complex-command ; Still in same complex command | 996 ((and same-complex-command ; Still in same complex command |
765 ; as last time outline-mode invoked. | 997 ; as last time outline-mode invoked. |
766 active ; Already activated. | 998 active ; Already activated. |
767 (not explicit-activation) ; Prop-line file-vars don't have args. | 999 (not explicit-activation) ; Prop-line file-vars don't have args. |
768 (string-match "^19.1[89]" ; Bug only known to be in v19.18 and | 1000 (string-match "^19.1[89]" ; Bug only known to be in v19.18 and |
769 emacs-version)); 19.19. | 1001 emacs-version)); 19.19. |
770 t) | 1002 t) |
771 | 1003 |
772 ;; Deactivate? | 1004 ;; Deactivation: |
773 ((and (not explicit-activation) | 1005 ((and (not explicit-activation) |
774 (or active toggle)) | 1006 (or active toggle)) |
775 ; Activation not explicitly | 1007 ; Activation not explicitly |
776 ; requested, and either in | 1008 ; requested, and either in |
777 ; active state or *de*activation | 1009 ; active state or *de*activation |
778 ; specifically requested: | 1010 ; specifically requested: |
1011 (setq outline-explicitly-deactivated t) | |
779 (if (string-match "^18\." emacs-version) | 1012 (if (string-match "^18\." emacs-version) |
780 ; Revoke those keys that remain | 1013 ; Revoke those keys that remain |
781 ; as we set them: | 1014 ; as we set them: |
782 (let ((curr-loc (current-local-map))) | 1015 (let ((curr-loc (current-local-map))) |
783 (mapcar '(lambda (cell) | 1016 (mapcar '(lambda (cell) |
784 (if (eq (lookup-key curr-loc (car cell)) | 1017 (if (eq (lookup-key curr-loc (car cell)) |
785 (car (cdr cell))) | 1018 (car (cdr cell))) |
786 (define-key curr-loc (car cell) | 1019 (define-key curr-loc (car cell) |
787 (assq (car cell) outline-prior-bindings)))) | 1020 (assq (car cell) outline-prior-bindings)))) |
788 outline-added-bindings) | 1021 outline-added-bindings) |
789 (outline-resumptions 'outline-added-bindings) | 1022 (outline-resumptions 'outline-added-bindings) |
790 (outline-resumptions 'outline-prior-bindings))) | 1023 (outline-resumptions 'outline-prior-bindings))) |
791 | 1024 |
792 (if outline-old-style-prefixes | 1025 (if outline-old-style-prefixes |
793 (progn | 1026 (progn |
794 (outline-resumptions 'outline-primary-bullet) | 1027 (outline-resumptions 'outline-primary-bullet) |
795 (outline-resumptions 'outline-old-style-prefixes))) | 1028 (outline-resumptions 'outline-old-style-prefixes))) |
796 (outline-resumptions 'selective-display) | 1029 (outline-resumptions 'selective-display) |
797 (if (and (boundp 'before-change-function) before-change-function) | 1030 (if (and (boundp 'before-change-function) before-change-function) |
798 (outline-resumptions 'before-change-function)) | 1031 (outline-resumptions 'before-change-function)) |
799 (setq pre-command-hook (delq 'outline-pre-command-business | 1032 (setq pre-command-hook (delq 'outline-pre-command-business |
800 pre-command-hook)) | 1033 pre-command-hook)) |
801 (setq post-command-hook (delq 'outline-post-command-business | |
802 post-command-hook)) | |
803 (setq local-write-file-hooks | 1034 (setq local-write-file-hooks |
804 (delq 'outline-write-file-hook | 1035 (delq 'outline-write-file-hook |
805 local-write-file-hooks)) | 1036 local-write-file-hooks)) |
806 (outline-resumptions 'paragraph-start) | 1037 (outline-resumptions 'paragraph-start) |
807 (outline-resumptions 'paragraph-separate) | 1038 (outline-resumptions 'paragraph-separate) |
808 (outline-resumptions (if (string-match "^18" emacs-version) | 1039 (outline-resumptions (if (string-match "^18" emacs-version) |
809 'auto-fill-hook | 1040 'auto-fill-hook |
810 'auto-fill-function)) | 1041 'auto-fill-function)) |
811 (outline-resumptions 'outline-former-auto-filler) | 1042 (outline-resumptions 'outline-former-auto-filler) |
812 (setq outline-mode nil)) | 1043 (setq outline-mode nil)) |
813 | 1044 |
814 ;; Activate? | 1045 ;; Activation: |
815 ((not active) | 1046 ((not active) |
1047 (setq outline-explicitly-deactivated nil) | |
816 (if outline-old-style-prefixes | 1048 (if outline-old-style-prefixes |
817 (progn ; Inhibit all the fancy formatting: | 1049 (progn ; Inhibit all the fancy formatting: |
818 (outline-resumptions 'outline-primary-bullet '("*")) | 1050 (outline-resumptions 'outline-primary-bullet '("*")) |
819 (outline-resumptions 'outline-old-style-prefixes '(())))) | 1051 (outline-resumptions 'outline-old-style-prefixes '(())))) |
1052 | |
1053 (outline-infer-header-lead) | |
1054 | |
820 (set-outline-regexp) | 1055 (set-outline-regexp) |
821 ; Produce map from current version | 1056 |
822 ; of outline-keybindings-list: | 1057 ; Produce map from current version |
1058 ; of outline-keybindings-list: | |
823 (if (boundp 'minor-mode-map-alist) | 1059 (if (boundp 'minor-mode-map-alist) |
824 | 1060 |
825 (progn ; V19, and maybe lucid and | 1061 (progn ; V19, and maybe lucid and |
826 ; epoch, minor-mode key bindings: | 1062 ; epoch, minor-mode key bindings: |
827 (setq outline-mode-map | 1063 (setq outline-mode-map |
828 (produce-outline-mode-map outline-keybindings-list)) | 1064 (produce-outline-mode-map outline-keybindings-list)) |
829 (fset 'outline-mode-map outline-mode-map) | 1065 (fset 'outline-mode-map outline-mode-map) |
830 ; Include on minor-mode-map-alist, | 1066 ; Include on minor-mode-map-alist, |
831 ; if not already there: | 1067 ; if not already there: |
832 (if (not (member '(outline-mode . outline-mode-map) | 1068 (if (not (member '(outline-mode . outline-mode-map) |
833 minor-mode-map-alist)) | 1069 minor-mode-map-alist)) |
834 (setq minor-mode-map-alist | 1070 (setq minor-mode-map-alist |
835 (cons '(outline-mode . outline-mode-map) | 1071 (cons '(outline-mode . outline-mode-map) |
836 minor-mode-map-alist)))) | 1072 minor-mode-map-alist)))) |
837 | 1073 |
838 ; V18 minor-mode key bindings: | 1074 ; V18 minor-mode key bindings: |
839 ; Stash record of added bindings | 1075 ; Stash record of added bindings |
840 ; for later revocation: | 1076 ; for later revocation: |
841 (outline-resumptions 'outline-added-bindings | 1077 (outline-resumptions 'outline-added-bindings |
842 (list outline-keybindings-list)) | 1078 (list outline-keybindings-list)) |
843 (outline-resumptions 'outline-prior-bindings | 1079 (outline-resumptions 'outline-prior-bindings |
844 (list (current-local-map))) | 1080 (list (current-local-map))) |
845 ; and add them: | 1081 ; and add them: |
846 (use-local-map (produce-outline-mode-map outline-keybindings-list | 1082 (use-local-map (produce-outline-mode-map outline-keybindings-list |
847 (current-local-map))) | 1083 (current-local-map))) |
848 ) | 1084 ) |
849 | 1085 |
850 ; selective-display is the | 1086 ; selective-display is the |
851 ; emacs conditional exposure | 1087 ; emacs conditional exposure |
852 ; mechanism: | 1088 ; mechanism: |
853 (outline-resumptions 'selective-display '(t)) | 1089 (outline-resumptions 'selective-display '(t)) |
854 (if outline-inhibit-protection | 1090 (if outline-inhibit-protection |
855 t | 1091 t |
856 (outline-resumptions 'before-change-function | 1092 (outline-resumptions 'before-change-function |
857 '(outline-before-change-protect))) | 1093 '(outline-before-change-protect))) |
858 (add-hook 'post-command-hook 'outline-post-command-business) | 1094 ; Temporarily set by any outline |
859 (add-hook 'pre-command-hook 'outline-pre-command-business) | 1095 ; functions that can be trusted to |
860 ; Temporarily set by any outline | 1096 ; deal properly with concealed text. |
861 ; functions that can be trusted to | |
862 ; deal properly with concealed text. | |
863 (add-hook 'local-write-file-hooks 'outline-write-file-hook) | 1097 (add-hook 'local-write-file-hooks 'outline-write-file-hook) |
864 ; Custom auto-fill func, to support | 1098 ; Custom auto-fill func, to support |
865 ; respect for topic headline, | 1099 ; respect for topic headline, |
866 ; hanging-indents, etc: | 1100 ; hanging-indents, etc: |
867 (let* ((fill-func-var (if (string-match "^18" emacs-version) | 1101 (let* ((fill-func-var (if (string-match "^18" emacs-version) |
868 'auto-fill-hook | 1102 'auto-fill-hook |
869 'auto-fill-function)) | 1103 'auto-fill-function)) |
870 (fill-func (symbol-value fill-func-var))) | 1104 (fill-func (symbol-value fill-func-var))) |
871 ;; Register prevailing fill func for use by outline-auto-fill: | 1105 ;; Register prevailing fill func for use by outline-auto-fill: |
872 (outline-resumptions 'outline-former-auto-filler (list fill-func)) | 1106 (outline-resumptions 'outline-former-auto-filler (list fill-func)) |
873 ;; Register outline-auto-fill to be used if filling is active: | 1107 ;; Register outline-auto-fill to be used if filling is active: |
874 (outline-resumptions fill-func-var '(outline-auto-fill))) | 1108 (outline-resumptions fill-func-var '(outline-auto-fill))) |
875 ;; Paragraphs are broken by topic headlines. | 1109 ;; Paragraphs are broken by topic headlines. |
876 (make-local-variable 'paragraph-start) | 1110 (make-local-variable 'paragraph-start) |
877 (outline-resumptions 'paragraph-start | 1111 (outline-resumptions 'paragraph-start |
878 (list (concat paragraph-start "\\|^\\(" | 1112 (list (concat paragraph-start "\\|^\\(" |
879 outline-regexp "\\)"))) | 1113 outline-regexp "\\)"))) |
880 (make-local-variable 'paragraph-separate) | 1114 (make-local-variable 'paragraph-separate) |
881 (outline-resumptions 'paragraph-separate | 1115 (outline-resumptions 'paragraph-separate |
882 (list (concat paragraph-separate "\\|^\\(" | 1116 (list (concat paragraph-separate "\\|^\\(" |
883 outline-regexp "\\)"))) | 1117 outline-regexp "\\)"))) |
884 | 1118 |
885 (or (assq 'outline-mode minor-mode-alist) | 1119 (or (assq 'outline-mode minor-mode-alist) |
886 (setq minor-mode-alist | 1120 (setq minor-mode-alist |
887 (cons '(outline-mode " Outl") minor-mode-alist))) | 1121 (cons '(outline-mode " Outl") minor-mode-alist))) |
1122 | |
1123 (if outline-layout | |
1124 (setq do-layout t)) | |
888 | 1125 |
889 (if outline-enwrap-isearch-mode | 1126 (if outline-enwrap-isearch-mode |
890 (outline-enwrap-isearch)) | 1127 (outline-enwrap-isearch)) |
1128 | |
891 (run-hooks 'outline-mode-hook) | 1129 (run-hooks 'outline-mode-hook) |
892 (setq outline-mode t)) | 1130 (setq outline-mode t)) |
1131 | |
1132 ;; Reactivation: | |
1133 ((setq do-layout t)) | |
893 ) ; cond | 1134 ) ; cond |
1135 | |
1136 (if (and do-layout | |
1137 outline-auto-activation | |
1138 (listp outline-layout) | |
1139 (and (not (eq outline-auto-activation 'activate)) | |
1140 (if (eq outline-auto-activation 'ask) | |
1141 (if (y-or-n-p (format "Expose %s with layout '%s'? " | |
1142 (buffer-name) | |
1143 outline-layout)) | |
1144 t | |
1145 (message "Not doing %s layout.") | |
1146 nil) | |
1147 t))) | |
1148 (save-excursion | |
1149 (message "Adjusting '%s' exposure..." (buffer-name)) | |
1150 (goto-char 0) | |
1151 (if (not (outline-goto-prefix)) | |
1152 (outline-next-heading)) | |
1153 (apply 'outline-expose-topic (list outline-layout)) | |
1154 (message "Adjusting '%s' exposure... done." (buffer-name)))) | |
894 outline-mode | 1155 outline-mode |
895 ) ; let* | 1156 ) ; let* |
896 ) ; defun | 1157 ) ; defun |
897 | 1158 |
898 | 1159 ;;;_ #3 Internal Position State-Tracking - "outline-recent-*" funcs |
899 ;;;_ #2 Internal Position State-Tracking Variables | 1160 ;;; All the basic outline functions that directly do string matches to |
900 ;;; All basic outline functions which directly do string matches to | |
901 ;;; evaluate heading prefix location set the variables | 1161 ;;; evaluate heading prefix location set the variables |
902 ;;; outline-recent-prefix-beginning and outline-recent-prefix-end when | 1162 ;;; `outline-recent-prefix-beginning' and `outline-recent-prefix-end' |
903 ;;; successful. Functions starting with 'outline-recent-' all use | 1163 ;;; when successful. Functions starting with `outline-recent-' all |
904 ;;; this state, providing the means to avoid redundant searches for | 1164 ;;; use this state, providing the means to avoid redundant searches |
905 ;;; just established data. This optimization can provide significant | 1165 ;;; for just-established data. This optimization can provide |
906 ;;; speed improvement, but it must be employed carefully. | 1166 ;;; significant speed improvement, but it must be employed carefully. |
907 ;;;_ = outline-recent-prefix-beginning | 1167 ;;;_ = outline-recent-prefix-beginning |
908 (defvar outline-recent-prefix-beginning 0 | 1168 (defvar outline-recent-prefix-beginning 0 |
909 "Buffer point of the start of the last topic prefix encountered.") | 1169 "Buffer point of the start of the last topic prefix encountered.") |
910 (make-variable-buffer-local 'outline-recent-prefix-beginning) | 1170 (make-variable-buffer-local 'outline-recent-prefix-beginning) |
911 ;;;_ = outline-recent-prefix-end | 1171 ;;;_ = outline-recent-prefix-end |
912 (defvar outline-recent-prefix-end 0 | 1172 (defvar outline-recent-prefix-end 0 |
913 "Buffer point of the end of the last topic prefix encountered.") | 1173 "Buffer point of the end of the last topic prefix encountered.") |
914 (make-variable-buffer-local 'outline-recent-prefix-end) | 1174 (make-variable-buffer-local 'outline-recent-prefix-end) |
1175 ;;;_ = outline-recent-end-of-subtree | |
1176 (defvar outline-recent-end-of-subtree 0 | |
1177 "Buffer point last returned by outline-end-of-current-subtree.") | |
1178 (make-variable-buffer-local 'outline-recent-end-of-subtree) | |
915 ;;;_ > outline-prefix-data (beg end) | 1179 ;;;_ > outline-prefix-data (beg end) |
916 (defmacro outline-prefix-data (beg end) | 1180 (defmacro outline-prefix-data (beg end) |
917 "Register outline-prefix state data - BEGINNING and END of prefix - | 1181 "Register outline-prefix state data - BEGINNING and END of prefix. |
918 for reference by 'outline-recent' funcs. Returns BEGINNING." | 1182 |
1183 For reference by 'outline-recent' funcs. Returns BEGINNING." | |
919 (` (setq outline-recent-prefix-end (, end) | 1184 (` (setq outline-recent-prefix-end (, end) |
920 outline-recent-prefix-beginning (, beg)))) | 1185 outline-recent-prefix-beginning (, beg)))) |
921 ;;;_ > outline-recent-depth () | 1186 ;;;_ > outline-recent-depth () |
922 (defmacro outline-recent-depth () | 1187 (defmacro outline-recent-depth () |
923 "Return depth of last heading encountered by an outline maneuvering | 1188 "Return depth of last heading encountered by an outline maneuvering function. |
924 function. | |
925 | 1189 |
926 All outline functions which directly do string matches to assess | 1190 All outline functions which directly do string matches to assess |
927 headings set the variables outline-recent-prefix-beginning and | 1191 headings set the variables outline-recent-prefix-beginning and |
928 outline-recent-prefix-end if successful. This function uses those settings | 1192 outline-recent-prefix-end if successful. This function uses those settings |
929 to return the current depth." | 1193 to return the current depth." |
941 to return the current depth." | 1205 to return the current depth." |
942 '(buffer-substring outline-recent-prefix-beginning | 1206 '(buffer-substring outline-recent-prefix-beginning |
943 outline-recent-prefix-end)) | 1207 outline-recent-prefix-end)) |
944 ;;;_ > outline-recent-bullet () | 1208 ;;;_ > outline-recent-bullet () |
945 (defmacro outline-recent-bullet () | 1209 (defmacro outline-recent-bullet () |
946 "Like outline-recent-prefix, but returns bullet of last encountered | 1210 "Like outline-recent-prefix, but returns bullet of last encountered prefix. |
947 prefix. | |
948 | 1211 |
949 All outline functions which directly do string matches to assess | 1212 All outline functions which directly do string matches to assess |
950 headings set the variables outline-recent-prefix-beginning and | 1213 headings set the variables outline-recent-prefix-beginning and |
951 outline-recent-prefix-end if successful. This function uses those settings | 1214 outline-recent-prefix-end if successful. This function uses those settings |
952 to return the current depth of the most recently matched topic." | 1215 to return the current depth of the most recently matched topic." |
953 '(buffer-substring (1- outline-recent-prefix-end) | 1216 '(buffer-substring (1- outline-recent-prefix-end) |
954 outline-recent-prefix-end)) | 1217 outline-recent-prefix-end)) |
955 | 1218 |
956 ;;;_ #3 Navigation | 1219 ;;;_ #4 Navigation |
957 | 1220 |
958 ;;;_ - Position Assessment | 1221 ;;;_ - Position Assessment |
959 ;;;_ : Location Predicates | 1222 ;;;_ : Location Predicates |
960 ;;;_ > outline-on-current-heading-p () | 1223 ;;;_ > outline-on-current-heading-p () |
961 (defun outline-on-current-heading-p () | 1224 (defun outline-on-current-heading-p () |
962 "Return prefix beginning point if point is on same line as current | 1225 "Return non-nil if point is on current visible topics' header line. |
963 visible topics' header line." | 1226 |
1227 Actually, returns prefix beginning point." | |
964 (save-excursion | 1228 (save-excursion |
965 (beginning-of-line) | 1229 (beginning-of-line) |
966 (and (looking-at outline-regexp) | 1230 (and (looking-at outline-regexp) |
967 (outline-prefix-data (match-beginning 0) (match-end 0))))) | 1231 (outline-prefix-data (match-beginning 0) (match-end 0))))) |
968 ;;;_ > outline-e-o-prefix-p () | 1232 ;;;_ > outline-e-o-prefix-p () |
969 (defun outline-e-o-prefix-p () | 1233 (defun outline-e-o-prefix-p () |
970 "True if point is located where current topic prefix ends, heading | 1234 "True if point is located where current topic prefix ends, heading begins." |
971 begins." | |
972 (and (save-excursion (beginning-of-line) | 1235 (and (save-excursion (beginning-of-line) |
973 (looking-at outline-regexp)) | 1236 (looking-at outline-regexp)) |
974 (= (point)(save-excursion (outline-end-of-prefix)(point))))) | 1237 (= (point)(save-excursion (outline-end-of-prefix)(point))))) |
975 ;;;_ > outline-hidden-p () | 1238 ;;;_ > outline-hidden-p () |
976 (defmacro outline-hidden-p () | 1239 (defmacro outline-hidden-p () |
984 (interactive) | 1247 (interactive) |
985 '(not (outline-hidden-p))) | 1248 '(not (outline-hidden-p))) |
986 ;;;_ : Location attributes | 1249 ;;;_ : Location attributes |
987 ;;;_ > outline-depth () | 1250 ;;;_ > outline-depth () |
988 (defmacro outline-depth () | 1251 (defmacro outline-depth () |
989 "Like outline-current-depth, but respects hidden as well as visible | 1252 "Like outline-current-depth, but respects hidden as well as visible topics." |
990 topics." | |
991 '(save-excursion | 1253 '(save-excursion |
992 (if (outline-goto-prefix) | 1254 (if (outline-goto-prefix) |
993 (outline-recent-depth) | 1255 (outline-recent-depth) |
994 (progn | 1256 (progn |
995 ;; Oops, no prefix, zero prefix data: | 1257 ;; Oops, no prefix, zero prefix data: |
996 (outline-prefix-data (point)(point)) | 1258 (outline-prefix-data (point)(point)) |
997 ;; ... and return 0: | 1259 ;; ... and return 0: |
998 0)))) | 1260 0)))) |
999 ;;;_ > outline-current-depth () | 1261 ;;;_ > outline-current-depth () |
1000 (defmacro outline-current-depth () | 1262 (defmacro outline-current-depth () |
1001 "Return the depth to which the current containing visible topic is | 1263 "Return nesting depth of visible topic most immediately containing point." |
1002 nested in the outline." | |
1003 '(save-excursion | 1264 '(save-excursion |
1004 (if (outline-back-to-current-heading) | 1265 (if (outline-back-to-current-heading) |
1005 (max 1 | 1266 (max 1 |
1006 (- outline-recent-prefix-end | 1267 (- outline-recent-prefix-end |
1007 outline-recent-prefix-beginning | 1268 outline-recent-prefix-beginning |
1054 (goto-char (or (match-beginning 2) | 1315 (goto-char (or (match-beginning 2) |
1055 outline-recent-prefix-beginning)) | 1316 outline-recent-prefix-beginning)) |
1056 (or (match-end 2) outline-recent-prefix-end))))) | 1317 (or (match-end 2) outline-recent-prefix-end))))) |
1057 ;;;_ > outline-previous-heading () | 1318 ;;;_ > outline-previous-heading () |
1058 (defmacro outline-previous-heading () | 1319 (defmacro outline-previous-heading () |
1059 "Move to the next \(possibly invisible) heading line. | 1320 "Move to the prior \(possibly invisible) heading line. |
1060 | 1321 |
1061 Return the location of the beginning of the heading, or nil if not found." | 1322 Return the location of the beginning of the heading, or nil if not found." |
1062 | 1323 |
1063 '(if (bobp) | 1324 '(if (bobp) |
1064 nil | 1325 nil |
1065 (outline-goto-prefix) | 1326 (outline-goto-prefix) |
1066 (if | 1327 (if |
1067 ;; searches are unbounded and return nil if failed: | 1328 ;; searches are unbounded and return nil if failed: |
1068 (or (re-search-backward outline-line-boundary-regexp nil 0) | 1329 (or (re-search-backward outline-line-boundary-regexp nil 0) |
1069 (looking-at outline-bob-regexp)) | 1330 (looking-at outline-bob-regexp)) |
1070 (progn;; Got some valid location state - set vars: | 1331 (progn ; Got valid location state - set vars: |
1071 (outline-prefix-data | 1332 (outline-prefix-data |
1072 (goto-char (or (match-beginning 2) | 1333 (goto-char (or (match-beginning 2) |
1073 outline-recent-prefix-beginning)) | 1334 outline-recent-prefix-beginning)) |
1074 (or (match-end 2) outline-recent-prefix-end)))))) | 1335 (or (match-end 2) outline-recent-prefix-end)))))) |
1075 | 1336 |
1081 ;;; requiring only a single regexp-search based traversal, to scope | 1342 ;;; requiring only a single regexp-search based traversal, to scope |
1082 ;;; out the subtopic locations. The chart then serves as the basis | 1343 ;;; out the subtopic locations. The chart then serves as the basis |
1083 ;;; for whatever assessment or adjustment of the subtree that is | 1344 ;;; for whatever assessment or adjustment of the subtree that is |
1084 ;;; required, without requiring redundant topic-traversal procedures. | 1345 ;;; required, without requiring redundant topic-traversal procedures. |
1085 | 1346 |
1086 ;;;_ > outline-chart-subtree (&optional orig-level prev-level) | 1347 ;;;_ > outline-chart-subtree (&optional levels orig-depth prev-depth) |
1087 (defun outline-chart-subtree (&optional orig-level prev-level) | 1348 (defun outline-chart-subtree (&optional levels orig-depth prev-depth) |
1088 "Produce a location 'chart' of subtopics of the containing topic. | 1349 "Produce a location \"chart\" of subtopics of the containing topic. |
1089 The entries for each immediate child consists of an integer for the | 1350 |
1090 point of the beginning of the topic, followed by a 'chart' of the | 1351 Optional argument LEVELS specifies the depth \(releative to start |
1091 immediate offspring of the subtopic, if any. | 1352 depth\) for the chart. Subsequent optional args are not for public |
1092 | 1353 use. |
1093 Use of charts enables efficient navigation of subtrees, by requiring | 1354 |
1094 only a single regexp-search based traversal, to scope out the subtopic | 1355 Charts are used to capture outline structure, so that outline-altering |
1095 locations. The chart then serves as the basis for whatever assessment | 1356 routines need assess the structure only once, and then use the chart |
1096 or adjustment of the subtree that is required, without requiring | 1357 for their elaborate manipulations. |
1097 redundant topic-traversal procedures. | 1358 |
1098 | 1359 Topics are entered in the chart so the last one is at the car. |
1099 The function parameters are for internal recursion, and should not be | 1360 The entry for each topic consists of an integer indicating the point |
1100 designated by external callers." | 1361 at the beginning of the topic. Charts for offspring consists of a |
1101 | 1362 list containing, recursively, the charts for the respective subtopics. |
1102 ;; We're constantly looking ahead. Impressive, huh? | 1363 The chart for a topics' offspring precedes the entry for the topic |
1103 | 1364 itself. |
1104 (let ((original (not orig-level)) ; 'here' passed only during recursion. | 1365 |
1105 chart here level) | 1366 The other function parameters are for internal recursion, and should |
1106 ; Initialize if not passed in: | 1367 not be specified by external callers. ORIG-DEPTH is depth of topic at |
1107 (if original | 1368 starting point, and PREV-DEPTH is depth of prior topic." |
1108 (progn (setq orig-level (outline-depth)) | 1369 |
1370 (let ((original (not orig-depth)) ; 'orig-depth' set only in recursion. | |
1371 chart curr-depth) | |
1372 | |
1373 (if original ; Just starting? | |
1374 ; Register initial settings and | |
1375 ; position to first offspring: | |
1376 (progn (setq orig-depth (outline-depth)) | |
1377 (or prev-depth (setq prev-depth (1+ orig-depth))) | |
1109 (outline-next-heading))) | 1378 (outline-next-heading))) |
1110 ; Consider only contents of orig topic: | 1379 |
1111 (if (not prev-level) | 1380 ;; Loop over the current levels' siblings. Besides being more |
1112 (setq prev-level (1+ orig-level))) | 1381 ;; efficient than tail-recursing over a level, it avoids exceeding |
1113 | 1382 ;; the typically quite constrained emacs max-lisp-eval-depth. |
1114 ;; Loop, rather than recurse, over the current levels' siblings, to | 1383 ;; Probably would speed things up to implement loop-based stack |
1115 ;; avoid overloading the typically quite constrained emacs max-lisp- | 1384 ;; operation rather than recursing for lower levels. Bah. |
1116 ;; eval-depth. | |
1117 (while (and (not (eobp)) | 1385 (while (and (not (eobp)) |
1118 (< orig-level (setq level (outline-recent-depth))) | 1386 ; Still within original topic? |
1119 ; Still within original topic: | 1387 (< orig-depth (setq curr-depth (outline-recent-depth))) |
1120 (cond ((= prev-level level) | 1388 (cond ((= prev-depth curr-depth) |
1121 (setq chart ; Register this one and move on: | 1389 ;; Register this one and move on: |
1122 (cons (point) chart)) | 1390 (setq chart (cons (point) chart)) |
1123 (outline-next-heading)) | 1391 (if (and levels (<= levels 1)) |
1124 | 1392 ;; At depth limit - skip sublevels: |
1125 ((< prev-level level) ; Do higher level, then | 1393 (or (outline-next-sibling curr-depth) |
1126 ; continue with this one: | 1394 ;; or no more siblings - proceed to |
1127 (setq chart (cons (outline-chart-subtree orig-level | 1395 ;; next heading at lesser depth: |
1128 level) | 1396 (while (<= curr-depth |
1129 chart)))))) | 1397 (outline-recent-depth)) |
1130 | 1398 (outline-next-heading))) |
1131 (if original ; We're at the end of the level... | 1399 (outline-next-heading))) |
1132 ; Position to the end of the branch: | 1400 |
1401 ((and (< prev-depth curr-depth) | |
1402 (or (not levels) | |
1403 (> levels 0))) | |
1404 ;; Recurse on deeper level of curr topic: | |
1405 (setq chart | |
1406 (cons (outline-chart-subtree (and levels | |
1407 (1- levels)) | |
1408 orig-depth | |
1409 curr-depth) | |
1410 chart)) | |
1411 ;; ... then continue with this one. | |
1412 ) | |
1413 | |
1414 ;; ... else nil if we've ascended back to prev-depth. | |
1415 | |
1416 ))) | |
1417 | |
1418 (if original ; We're at the last sibling on | |
1419 ; the original level. Position | |
1420 ; to the end of it: | |
1133 (progn (and (not (eobp)) (forward-char -1)) | 1421 (progn (and (not (eobp)) (forward-char -1)) |
1134 (and (memq (preceding-char) '(?\n ?\^M)) | 1422 (and (memq (preceding-char) '(?\n ?\^M)) |
1135 (memq (aref (buffer-substring (max 1 (- (point) 3)) | 1423 (memq (aref (buffer-substring (max 1 (- (point) 3)) |
1136 (point)) | 1424 (point)) |
1137 1) | 1425 1) |
1138 '(?\n ?\^M)) | 1426 '(?\n ?\^M)) |
1139 (forward-char -1)))) | 1427 (forward-char -1)) |
1428 (setq outline-recent-end-of-subtree (point)))) | |
1140 | 1429 |
1141 chart ; (nreverse chart) not necessary, | 1430 chart ; (nreverse chart) not necessary, |
1142 ; and maybe not preferable. | 1431 ; and maybe not preferable. |
1143 )) | 1432 )) |
1144 ;;;_ > outline-chart-topic (&optional orig-level prev-level) | |
1145 (defmacro outline-chart-topic () | |
1146 "Return a location 'chart' for the current topic and its subtopics,if any. | |
1147 See 'outline-chart-subtree' for an explanation of charts." | |
1148 | |
1149 '(if (outline-goto-prefix) | |
1150 (let ((here (point)) | |
1151 (subtree (outline-chart-subtree orig-level prev-level))) | |
1152 (if subtree | |
1153 (list here subtree) | |
1154 (list here))))) | |
1155 ;;;_ > outline-chart-siblings (&optional start end) | 1433 ;;;_ > outline-chart-siblings (&optional start end) |
1156 (defun outline-chart-siblings (&optional start end) | 1434 (defun outline-chart-siblings (&optional start end) |
1157 "Produce a list of locations of this and succeeding sibling topics. | 1435 "Produce a list of locations of this and succeeding sibling topics. |
1158 Effectively a top-level chart of siblings. See 'outline-chart-subtree' | 1436 Effectively a top-level chart of siblings. See 'outline-chart-subtree' |
1159 for an explanation of charts." | 1437 for an explanation of charts." |
1160 (save-excursion | 1438 (save-excursion |
1161 (if (outline-goto-prefix) | 1439 (if (outline-goto-prefix) |
1162 (let ((chart (list (point)))) | 1440 (let ((chart (list (point)))) |
1163 (while (outline-next-sibling) | 1441 (while (outline-next-sibling) |
1164 (setq chart (cons (point) chart))) | 1442 (setq chart (cons (point) chart))) |
1165 (if chart (setq chart (nreverse chart)))))) | 1443 (if chart (setq chart (nreverse chart))))))) |
1166 ) | |
1167 ;;;_ > outline-chart-to-reveal (chart depth) | 1444 ;;;_ > outline-chart-to-reveal (chart depth) |
1168 (defun outline-chart-to-reveal (chart depth) | 1445 (defun outline-chart-to-reveal (chart depth) |
1169 | 1446 |
1170 "Return a flat list of the points in subtree CHART, up to DEPTH, which | 1447 "Return a flat list of hidden points in subtree CHART, up to DEPTH. |
1171 are hidden. | 1448 |
1172 | 1449 Note that point can be left at any of the points on chart, or at the |
1173 Note that point can wind up at any of the points on chart, or at the | |
1174 start point." | 1450 start point." |
1175 | 1451 |
1176 (let (result here) | 1452 (let (result here) |
1177 (while (and (or (eq depth t) (> depth 0)) | 1453 (while (and (or (eq depth t) (> depth 0)) |
1178 chart) | 1454 chart) |
1187 (goto-char here) | 1463 (goto-char here) |
1188 (if (= (preceding-char) ?\r) | 1464 (if (= (preceding-char) ?\r) |
1189 (setq result (cons here result))) | 1465 (setq result (cons here result))) |
1190 (setq chart (cdr chart)))) | 1466 (setq chart (cdr chart)))) |
1191 result)) | 1467 result)) |
1192 ;;;_ > outline-chart-spec (chart spec &optional exposing) | 1468 ;;;_ X outline-chart-spec (chart spec &optional exposing) |
1193 (defun outline-chart-spec (chart spec &optional exposing) | 1469 (defun outline-chart-spec (chart spec &optional exposing) |
1194 "Given a topic/subtree CHART and an exposure SPEC, produce a list of | 1470 "Not yet \(if ever\) implemented. |
1195 exposure directive, indicating the locations to be exposed and the | 1471 |
1196 prescribed exposure status. Optional arg EXPOSING is an integer, with | 1472 Produce exposure directives given topic/subtree CHART and an exposure SPEC. |
1197 0 indicating pending concealment, anything higher indicating depth to | 1473 |
1474 Exposure spec indicates the locations to be exposed and the prescribed | |
1475 exposure status. Optional arg EXPOSING is an integer, with 0 | |
1476 indicating pending concealment, anything higher indicating depth to | |
1198 which subtopic headers should be exposed, and negative numbers | 1477 which subtopic headers should be exposed, and negative numbers |
1199 indicating (negative of) the depth to which subtopic headers and | 1478 indicating (negative of) the depth to which subtopic headers and |
1200 bodies should be exposed. | 1479 bodies should be exposed. |
1201 | 1480 |
1202 The produced list can have two types of entries. Bare numbers | 1481 The produced list can have two types of entries. Bare numbers |
1203 indicate points in the buffer where topic headers that should be | 1482 indicate points in the buffer where topic headers that should be |
1204 exposed reside. | 1483 exposed reside. |
1484 | |
1205 - bare negative numbers indicates that the topic starting at the | 1485 - bare negative numbers indicates that the topic starting at the |
1206 point which is the negative of the number should be opened, | 1486 point which is the negative of the number should be opened, |
1207 including their entries. | 1487 including their entries. |
1208 - bare positive values indicate that this topic header should be | 1488 - bare positive values indicate that this topic header should be |
1209 openned. | 1489 openned. |
1218 ) | 1498 ) |
1219 | 1499 |
1220 ;;;_ - Within Topic | 1500 ;;;_ - Within Topic |
1221 ;;;_ > outline-goto-prefix () | 1501 ;;;_ > outline-goto-prefix () |
1222 (defun outline-goto-prefix () | 1502 (defun outline-goto-prefix () |
1223 "Put point at beginning of outline prefix for immediately containing | 1503 "Put point at beginning of outline prefix for immediately containing topic. |
1224 topic, visible or not. | 1504 |
1505 Goes to first subsequent topic if none immediately containing. | |
1506 | |
1507 Not sensitive to topic visibility. | |
1225 | 1508 |
1226 Returns a the point at the beginning of the prefix, or nil if none." | 1509 Returns a the point at the beginning of the prefix, or nil if none." |
1227 | 1510 |
1228 (if (= (point-min)(point-max)) | 1511 (let (done) |
1229 nil | 1512 (while (and (not done) |
1230 (let (done) | 1513 (re-search-backward "[\n\r]" nil 1)) |
1231 (while (and (not done) | 1514 (forward-char 1) |
1232 (re-search-backward "[\n\r]" nil 1)) | 1515 (if (looking-at outline-regexp) |
1233 (forward-char 1) | 1516 (setq done (outline-prefix-data (match-beginning 0) |
1234 (if (looking-at outline-regexp) | 1517 (match-end 0))) |
1235 (setq done (outline-prefix-data (match-beginning 0) | 1518 (forward-char -1))) |
1236 (match-end 0))) | 1519 (if (bobp) |
1237 (forward-char -1))) | 1520 (cond ((looking-at outline-regexp) |
1238 (if (and (bobp) | 1521 (outline-prefix-data (match-beginning 0)(match-end 0))) |
1239 (looking-at outline-regexp)) | 1522 ((outline-next-heading) |
1240 (outline-prefix-data (match-beginning 0)(match-end 0)) | 1523 (outline-prefix-data (match-beginning 0)(match-end 0))) |
1241 done)))) | 1524 (done)) |
1525 done))) | |
1242 ;;;_ > outline-end-of-prefix () | 1526 ;;;_ > outline-end-of-prefix () |
1243 (defun outline-end-of-prefix (&optional ignore-decorations) | 1527 (defun outline-end-of-prefix (&optional ignore-decorations) |
1244 "Position cursor at beginning of header text, or just after bullet | 1528 "Position cursor at beginning of header text. |
1245 if optional IGNORE-DECORATIONS non-nil." | 1529 |
1530 If optional IGNORE-DECORATIONS is non-nil, put just after bullet, | |
1531 otherwise skip white space between bullet and ensuing text." | |
1246 | 1532 |
1247 (if (not (outline-goto-prefix)) | 1533 (if (not (outline-goto-prefix)) |
1248 nil | 1534 nil |
1249 (let ((match-data (match-data))) | 1535 (let ((match-data (match-data))) |
1250 (goto-char (match-end 0)) | 1536 (goto-char (match-end 0)) |
1262 (if (not (outline-current-depth)) | 1548 (if (not (outline-current-depth)) |
1263 nil | 1549 nil |
1264 (1- (match-end 0)))) | 1550 (1- (match-end 0)))) |
1265 ;;;_ > outline-back-to-current-heading () | 1551 ;;;_ > outline-back-to-current-heading () |
1266 (defun outline-back-to-current-heading () | 1552 (defun outline-back-to-current-heading () |
1267 "Move to heading line of current visible topic, or beginning of heading | 1553 "Move to heading line of current topic, or beginning if already on the line." |
1268 if already on visible heading line." | 1554 |
1269 (beginning-of-line) | 1555 (beginning-of-line) |
1270 (prog1 (or (outline-on-current-heading-p) | 1556 (prog1 (or (outline-on-current-heading-p) |
1271 (and (re-search-backward (concat "^\\(" outline-regexp "\\)") | 1557 (and (re-search-backward (concat "^\\(" outline-regexp "\\)") |
1272 nil | 1558 nil |
1273 'move) | 1559 'move) |
1285 ;;;_ > outline-end-of-current-subtree () | 1571 ;;;_ > outline-end-of-current-subtree () |
1286 (defun outline-end-of-current-subtree () | 1572 (defun outline-end-of-current-subtree () |
1287 "Put point at the end of the last leaf in the currently visible topic." | 1573 "Put point at the end of the last leaf in the currently visible topic." |
1288 (interactive) | 1574 (interactive) |
1289 (outline-back-to-current-heading) | 1575 (outline-back-to-current-heading) |
1290 (let ((opoint (point)) | 1576 (let ((level (outline-recent-depth))) |
1291 (level (outline-recent-depth))) | |
1292 (outline-next-heading) | 1577 (outline-next-heading) |
1293 (while (and (not (eobp)) | 1578 (while (and (not (eobp)) |
1294 (> (outline-recent-depth) level)) | 1579 (> (outline-recent-depth) level)) |
1295 (outline-next-heading)) | 1580 (outline-next-heading)) |
1296 (and (not (eobp)) (forward-char -1)) | 1581 (and (not (eobp)) (forward-char -1)) |
1297 (and (memq (preceding-char) '(?\n ?\^M)) | 1582 (and (memq (preceding-char) '(?\n ?\^M)) |
1298 (memq (aref (buffer-substring (max 1 (- (point) 3)) (point)) 1) | 1583 (memq (aref (buffer-substring (max 1 (- (point) 3)) (point)) 1) |
1299 '(?\n ?\^M)) | 1584 '(?\n ?\^M)) |
1300 (forward-char -1)) | 1585 (forward-char -1)) |
1301 (point))) | 1586 (setq outline-recent-end-of-subtree (point)))) |
1302 ;;;_ > outline-beginning-of-current-entry () | 1587 ;;;_ > outline-beginning-of-current-entry () |
1303 (defun outline-beginning-of-current-entry () | 1588 (defun outline-beginning-of-current-entry () |
1304 "When not already there, position the point at the beginning of the | 1589 "When not already there, position point at beginning of current topic's body. |
1305 body of the current topic. | |
1306 | 1590 |
1307 If already there, move cursor to bullet for hot-spot operation. | 1591 If already there, move cursor to bullet for hot-spot operation. |
1308 \(See outline-mode doc string for details on hot-spot operation.)" | 1592 \(See outline-mode doc string for details on hot-spot operation.)" |
1309 (interactive) | 1593 (interactive) |
1310 (let ((start-point (point))) | 1594 (let ((start-point (point))) |
1317 "Position the point at the end of the current topics' entry." | 1601 "Position the point at the end of the current topics' entry." |
1318 (interactive) | 1602 (interactive) |
1319 (outline-show-entry) | 1603 (outline-show-entry) |
1320 (prog1 (outline-pre-next-preface) | 1604 (prog1 (outline-pre-next-preface) |
1321 (if (and (not (bobp))(looking-at "^$")) | 1605 (if (and (not (bobp))(looking-at "^$")) |
1322 (forward-char -1))) | 1606 (forward-char -1)))) |
1323 ) | |
1324 | 1607 |
1325 ;;;_ - Depth-wise | 1608 ;;;_ - Depth-wise |
1326 ;;;_ > outline-ascend-to-depth (depth) | 1609 ;;;_ > outline-ascend-to-depth (depth) |
1327 (defun outline-ascend-to-depth (depth) | 1610 (defun outline-ascend-to-depth (depth) |
1328 "Ascend to depth DEPTH, returning depth if successful, nil if not." | 1611 "Ascend to depth DEPTH, returning depth if successful, nil if not." |
1338 (goto-char last-good) | 1621 (goto-char last-good) |
1339 nil)) | 1622 nil)) |
1340 (if (interactive-p) (outline-end-of-prefix)))) | 1623 (if (interactive-p) (outline-end-of-prefix)))) |
1341 ;;;_ > outline-descend-to-depth (depth) | 1624 ;;;_ > outline-descend-to-depth (depth) |
1342 (defun outline-descend-to-depth (depth) | 1625 (defun outline-descend-to-depth (depth) |
1343 "Descend to depth DEPTH within current topic, returning depth if | 1626 "Descend to depth DEPTH within current topic. |
1344 successful, nil if not." | 1627 |
1628 Returning depth if successful, nil if not." | |
1345 (let ((start-point (point)) | 1629 (let ((start-point (point)) |
1346 (start-depth (outline-depth))) | 1630 (start-depth (outline-depth))) |
1347 (while | 1631 (while |
1348 (and (> (outline-depth) 0) | 1632 (and (> (outline-depth) 0) |
1349 (not (= depth (outline-recent-depth))) ; ... not there yet | 1633 (not (= depth (outline-recent-depth))) ; ... not there yet |
1355 (goto-char start-point) | 1639 (goto-char start-point) |
1356 nil)) | 1640 nil)) |
1357 ) | 1641 ) |
1358 ;;;_ > outline-up-current-level (arg &optional dont-complain) | 1642 ;;;_ > outline-up-current-level (arg &optional dont-complain) |
1359 (defun outline-up-current-level (arg &optional dont-complain) | 1643 (defun outline-up-current-level (arg &optional dont-complain) |
1360 "Move to the heading line of which the present line is a subheading. | 1644 "Move out ARG levels from current visible topic. |
1361 With argument, move up ARG levels. Don't return an error if | 1645 |
1362 second, optional argument DONT-COMPLAIN, is non-nil." | 1646 Positions on heading line of containing topic. Error if unable to |
1647 ascend that far, or nil if unable to ascend but optional arg | |
1648 DONT-COMPLAIN is non-nil." | |
1363 (interactive "p") | 1649 (interactive "p") |
1364 (outline-back-to-current-heading) | 1650 (outline-back-to-current-heading) |
1365 (let ((present-level (outline-recent-depth))) | 1651 (let ((present-level (outline-recent-depth)) |
1652 (last-good (point)) | |
1653 failed | |
1654 return) | |
1366 ;; Loop for iterating arg: | 1655 ;; Loop for iterating arg: |
1367 (while (and (> (outline-recent-depth) 1) | 1656 (while (and (> (outline-recent-depth) 1) |
1368 (> arg 0) | 1657 (> arg 0) |
1369 (not (bobp))) | 1658 (not (bobp)) |
1659 (not failed)) | |
1660 (setq last-good (point)) | |
1370 ;; Loop for going back over current or greater depth: | 1661 ;; Loop for going back over current or greater depth: |
1371 (while (and (not (< (outline-recent-depth) present-level)) | 1662 (while (and (not (< (outline-recent-depth) present-level)) |
1372 (outline-previous-visible-heading 1))) | 1663 (or (outline-previous-visible-heading 1) |
1664 (not (setq failed present-level))))) | |
1373 (setq present-level (outline-current-depth)) | 1665 (setq present-level (outline-current-depth)) |
1374 (setq arg (- arg 1))) | 1666 (setq arg (- arg 1))) |
1375 ) | 1667 (if (or failed |
1376 (prog1 (if (<= arg 0) | 1668 (> arg 0)) |
1377 outline-recent-prefix-beginning | 1669 (progn (goto-char last-good) |
1378 (if (interactive-p) (outline-end-of-prefix)) | 1670 (if (interactive-p) (outline-end-of-prefix)) |
1379 (if (not dont-complain) | 1671 (if (not dont-complain) |
1380 (error "Can't ascend past outermost level."))) | 1672 (error "Can't ascend past outermost level.") |
1381 (if (interactive-p) (outline-end-of-prefix))) | 1673 (if (interactive-p) (outline-end-of-prefix)) |
1382 ) | 1674 nil)) |
1675 (if (interactive-p) (outline-end-of-prefix)) | |
1676 outline-recent-prefix-beginning))) | |
1383 | 1677 |
1384 ;;;_ - Linear | 1678 ;;;_ - Linear |
1385 ;;;_ > outline-next-sibling (&optional depth backward) | 1679 ;;;_ > outline-next-sibling (&optional depth backward) |
1386 (defun outline-next-sibling (&optional depth backward) | 1680 (defun outline-next-sibling (&optional depth backward) |
1387 "Like outline-forward-current-level, but respects invisible topics. | 1681 "Like outline-forward-current-level, but respects invisible topics. |
1408 (goto-char start-point) | 1702 (goto-char start-point) |
1409 (if depth (outline-depth) start-depth) | 1703 (if depth (outline-depth) start-depth) |
1410 nil)))) | 1704 nil)))) |
1411 ;;;_ > outline-previous-sibling (&optional depth backward) | 1705 ;;;_ > outline-previous-sibling (&optional depth backward) |
1412 (defun outline-previous-sibling (&optional depth backward) | 1706 (defun outline-previous-sibling (&optional depth backward) |
1413 "Like outline-forward-current-level, but goes backwards and respects | 1707 "Like outline-forward-current-level,but backwards & respect invisible topics. |
1414 invisible topics. | |
1415 | 1708 |
1416 Optional DEPTH specifies depth to traverse, default current depth. | 1709 Optional DEPTH specifies depth to traverse, default current depth. |
1417 | 1710 |
1418 Optional BACKWARD reverses direction. | 1711 Optional BACKWARD reverses direction. |
1419 | 1712 |
1420 Return depth if successful, nil otherwise." | 1713 Return depth if successful, nil otherwise." |
1421 (outline-next-sibling depth (not backward)) | 1714 (outline-next-sibling depth (not backward)) |
1422 ) | 1715 ) |
1423 ;;;_ > outline-snug-back () | 1716 ;;;_ > outline-snug-back () |
1424 (defun outline-snug-back () | 1717 (defun outline-snug-back () |
1425 "Position cursor at end of previous topic, presuming that we are at | 1718 "Position cursor at end of previous topic |
1426 the start of a topic prefix." | 1719 |
1720 Presumes point is at the start of a topic prefix." | |
1427 (if (or (bobp) (eobp)) | 1721 (if (or (bobp) (eobp)) |
1428 nil | 1722 nil |
1429 (forward-char -1)) | 1723 (forward-char -1)) |
1430 (if (or (bobp) (not (memq (preceding-char) '(?\n ?\^M)))) | 1724 (if (or (bobp) (not (memq (preceding-char) '(?\n ?\^M)))) |
1431 nil | 1725 nil |
1445 (while (outline-previous-sibling depth nil)) | 1739 (while (outline-previous-sibling depth nil)) |
1446 (prog1 (outline-recent-depth) | 1740 (prog1 (outline-recent-depth) |
1447 (if (interactive-p) (outline-end-of-prefix))))) | 1741 (if (interactive-p) (outline-end-of-prefix))))) |
1448 ;;;_ > outline-next-visible-heading (arg) | 1742 ;;;_ > outline-next-visible-heading (arg) |
1449 (defun outline-next-visible-heading (arg) | 1743 (defun outline-next-visible-heading (arg) |
1450 "Move to the next visible heading line, or as far as possible in | 1744 "Move to the next ARG'th visible heading line, backward if arg is negative. |
1451 indicated direction if no more headings to be found. | 1745 |
1452 | 1746 Move as far as possible in indicated direction \(beginning or end of |
1453 With argument, repeats, backward if negative." | 1747 buffer\) if headings are exhausted." |
1454 | 1748 |
1455 (interactive "p") | 1749 (interactive "p") |
1456 (let* ((backward (if (< arg 0) (setq arg (* -1 arg)))) | 1750 (let* ((backward (if (< arg 0) (setq arg (* -1 arg)))) |
1457 (step (if backward -1 1)) | 1751 (step (if backward -1 1)) |
1752 (start-point (point)) | |
1458 prev got) | 1753 prev got) |
1459 | 1754 |
1460 (while (> arg 0) ; limit condition | 1755 (while (> arg 0) ; limit condition |
1461 (while (and (not (if backward (bobp)(eobp))) ; boundary condition | 1756 (while (and (not (if backward (bobp)(eobp))) ; boundary condition |
1462 (progn | 1757 ;; Move, skipping over all those concealed lines: |
1463 ;; Move, skipping over all those concealed lines: | 1758 (< -1 (forward-line step)) |
1464 (forward-line step) | 1759 (not (setq got (looking-at outline-regexp))))) |
1465 (not (setq got (looking-at outline-regexp)))))) | |
1466 ;; Register this got, it may be the last: | 1760 ;; Register this got, it may be the last: |
1467 (if got (setq prev got)) | 1761 (if got (setq prev got)) |
1468 (setq arg (1- arg))) | 1762 (setq arg (1- arg))) |
1469 (cond (got ; Last move was to a prefix: | 1763 (cond (got ; Last move was to a prefix: |
1470 (outline-prefix-data (match-beginning 0) (match-end 0)) | 1764 (outline-prefix-data (match-beginning 0) (match-end 0)) |
1481 matches)." | 1775 matches)." |
1482 (interactive "p") | 1776 (interactive "p") |
1483 (outline-next-visible-heading (- arg))) | 1777 (outline-next-visible-heading (- arg))) |
1484 ;;;_ > outline-forward-current-level (arg) | 1778 ;;;_ > outline-forward-current-level (arg) |
1485 (defun outline-forward-current-level (arg) | 1779 (defun outline-forward-current-level (arg) |
1486 "Position the point at the next heading of the same level, taking | 1780 "Position point at the next heading of the same level. |
1487 optional repeat-count. | 1781 |
1488 | 1782 Takes optional repeat-count, goes backward if count is negative. |
1489 Non-nil optional arg BACKWARD reverses direction. | 1783 |
1490 | 1784 Returns resulting position, else nil if none found." |
1491 Returns that position, else nil if is not found." | |
1492 (interactive "p") | 1785 (interactive "p") |
1493 (if (and (< arg 0) (bobp)) | 1786 (let ((start-depth (outline-current-depth)) |
1494 nil | 1787 (start-point (point)) |
1495 (let ((start-depth (save-excursion | 1788 (start-arg arg) |
1496 (outline-back-to-current-heading) | 1789 (backward (> 0 arg)) |
1497 (outline-depth))) | 1790 last-depth |
1498 (start-point (point)) | 1791 (last-good (point)) |
1499 (backward (> 0 arg)) | 1792 at-boundary) |
1500 last-depth | 1793 (if (= 0 start-depth) |
1501 (last-good (point))) | 1794 (error "No siblings, not in a topic...")) |
1502 (if backward (setq arg (* -1 arg))) | 1795 (if backward (setq arg (* -1 arg))) |
1503 (while (> arg 0) | 1796 (while (not (or (zerop arg) |
1504 (while (and (not (if backward (bobp) (eobp))) | 1797 at-boundary)) |
1505 (if backward (outline-previous-visible-heading 1) | 1798 (while (and (not (if backward (bobp) (eobp))) |
1506 (outline-next-visible-heading 1)) | 1799 (if backward (outline-previous-visible-heading 1) |
1507 (> (setq last-depth (outline-recent-depth)) start-depth))) | 1800 (outline-next-visible-heading 1)) |
1508 (if (and last-depth (= last-depth start-depth) ) | 1801 (> (setq last-depth (outline-recent-depth)) start-depth))) |
1509 (setq last-good (point) | 1802 (if (and last-depth (= last-depth start-depth) |
1510 arg (1- arg)) | 1803 (not (if backward (bobp) (eobp)))) |
1511 (setq arg -1))) | 1804 (setq last-good (point) |
1512 (if (and (not (eobp)) | 1805 arg (1- arg)) |
1513 (and (> (or last-depth (outline-depth)) 0) | 1806 (setq at-boundary t))) |
1514 (= (outline-recent-depth) start-depth))) | 1807 (if (and (not (eobp)) |
1515 outline-recent-prefix-beginning | 1808 (= arg 0) |
1516 (goto-char last-good) | 1809 (and (> (or last-depth (outline-depth)) 0) |
1517 (if (not (interactive-p)) | 1810 (= (outline-recent-depth) start-depth))) |
1518 nil | 1811 outline-recent-prefix-beginning |
1519 (outline-end-of-prefix) | 1812 (goto-char last-good) |
1520 (error "This is the %s topic on level %d." | 1813 (if (not (interactive-p)) |
1521 (if backward "first" "last") | 1814 nil |
1522 (outline-recent-depth))))))) | 1815 (outline-end-of-prefix) |
1816 (error "Hit %s level %d topic, traversed %d of %d requested." | |
1817 (if backward "first" "last") | |
1818 (outline-recent-depth) | |
1819 (- (abs start-arg) arg) | |
1820 (abs start-arg)))))) | |
1523 ;;;_ > outline-backward-current-level (arg) | 1821 ;;;_ > outline-backward-current-level (arg) |
1524 (defun outline-backward-current-level (arg) | 1822 (defun outline-backward-current-level (arg) |
1525 "Position the point at the previous heading of the same level, taking | 1823 "Inverse of `outline-forward-current-level'." |
1526 optional repeat-count. | |
1527 | |
1528 Returns that position, else nil if is not found." | |
1529 (interactive "p") | 1824 (interactive "p") |
1530 (unwind-protect | 1825 (if (interactive-p) |
1531 (if (interactive-p) | 1826 (let ((current-prefix-arg (* -1 arg))) |
1532 (let ((current-prefix-arg (* -1 arg))) | 1827 (call-interactively 'outline-forward-current-level)) |
1533 (call-interactively 'outline-forward-current-level)) | 1828 (outline-forward-current-level (* -1 arg)))) |
1534 (outline-forward-current-level (* -1 arg))) | 1829 |
1535 (outline-end-of-prefix))) | 1830 ;;;_ #5 Alteration |
1536 | |
1537 ;;;_ #4 Alteration | |
1538 | 1831 |
1539 ;;;_ - Fundamental | 1832 ;;;_ - Fundamental |
1540 ;;;_ > outline-before-change-protect (beg end) | 1833 ;;;_ > outline-before-change-protect (beg end) |
1541 (defun outline-before-change-protect (beg end) | 1834 (defun outline-before-change-protect (beg end) |
1542 "Reveal concealed text pending improper (non-integral) changes, and | 1835 "Outline before-change hook, regulates changes to concealed text. |
1836 | |
1837 Reveal concealed text that would be changed by current command, and | |
1543 offer user choice to commit or forego the change. Unchanged text is | 1838 offer user choice to commit or forego the change. Unchanged text is |
1544 reconcealed. User has option to have changed text reconcealed. | 1839 reconcealed. User has option to have changed text reconcealed. |
1545 | 1840 |
1546 Undo commands are specially treated - the user is not prompted for | 1841 Undo commands are specially treated - the user is not prompted for |
1547 choice, the undoes are always committed (based on presumption that the | 1842 choice, the undoes are always committed (based on presumption that the |
1586 ;; - Presumably, undoing what was properly protected when | 1881 ;; - Presumably, undoing what was properly protected when |
1587 ;; done. | 1882 ;; done. |
1588 ;; - Undo may be users' only recourse in protection faults. | 1883 ;; - Undo may be users' only recourse in protection faults. |
1589 ;; So, expose what getting changed: | 1884 ;; So, expose what getting changed: |
1590 (progn (message "Undo! - exposing concealed target...") | 1885 (progn (message "Undo! - exposing concealed target...") |
1591 (sit-for 0) | |
1592 (if (outline-hidden-p) | 1886 (if (outline-hidden-p) |
1593 (outline-show-children)) | 1887 (outline-show-children)) |
1594 (message "Undo!") | 1888 (message "Undo!")) |
1595 (sit-for 0)) | |
1596 (let (response | 1889 (let (response |
1597 (rehide-completely (save-excursion (outline-goto-prefix) | 1890 (rehide-completely (save-excursion (outline-goto-prefix) |
1598 (outline-hidden-p))) | 1891 (outline-hidden-p))) |
1599 rehide-place) | 1892 rehide-place) |
1600 | 1893 |
1654 "Change within concealed region prevented."))))))) | 1947 "Change within concealed region prevented."))))))) |
1655 ) ; if | 1948 ) ; if |
1656 ) ; defun | 1949 ) ; defun |
1657 ;;;_ = outline-post-goto-bullet | 1950 ;;;_ = outline-post-goto-bullet |
1658 (defvar outline-post-goto-bullet nil | 1951 (defvar outline-post-goto-bullet nil |
1659 "Outline internal var, when set tells post-processing to reposition | 1952 "Outline internal var, for `outline-pre-command-business' hot-spot operation. |
1660 on topic bullet, and then unset it. Set by outline-pre-command- | 1953 |
1661 business when implementing hot-spot operation, where literal | 1954 When set, tells post-processing to reposition on topic bullet, and |
1662 characters typed over a topic bullet are mapped to the command | 1955 then unset it. Set by outline-pre-command-business when implementing |
1663 of the corresponding control-key on the outline-mode-map.") | 1956 hot-spot operation, where literal characters typed over a topic bullet |
1957 are mapped to the command of the corresponding control-key on the | |
1958 outline-mode-map.") | |
1664 (make-variable-buffer-local 'outline-post-goto-bullet) | 1959 (make-variable-buffer-local 'outline-post-goto-bullet) |
1665 ;;;_ > outline-post-command-business () | 1960 ;;;_ > outline-post-command-business () |
1666 (defun outline-post-command-business () | 1961 (defun outline-post-command-business () |
1667 "A post-command-hook function for outline buffers, takes care of some | 1962 "Outline post-command-hook function. |
1668 loose ends left by outline-before-change-protect. | 1963 |
1669 | 1964 - Null outline-override-protect, so it's not left open. |
1670 - Nulls outline-override-protect, so it's not left open. | 1965 |
1671 | 1966 - Implement (and clear) outline-post-goto-bullet, for hot-spot |
1672 - Implements (and clears) outline-post-goto-bullet, for hot-spot | |
1673 outline commands. | 1967 outline commands. |
1674 | 1968 |
1675 - Massages buffer-undo-list so successive, standard character self-inserts are | 1969 - Massages buffer-undo-list so successive, standard character self-inserts are |
1676 aggregated. This kludge compensates for lack of undo bunching when | 1970 aggregated. This kludge compensates for lack of undo bunching when |
1677 before-change-function is used." | 1971 before-change-function is used." |
1678 | 1972 |
1679 ; Apply any external change func: | 1973 ; Apply any external change func: |
1680 (if (outline-mode-p) ; In outline-mode. | 1974 (if (not (outline-mode-p)) ; In outline-mode. |
1681 (progn | 1975 nil |
1682 (setq outline-override-protect nil) | 1976 (setq outline-override-protect nil) |
1683 (and outline-during-write-cue | 1977 (if outline-during-write-cue |
1684 (setq outline-during-write-cue nil)) | 1978 ;; Was used by outline-before-change-protect, done with it now: |
1685 ;; Undo bunching business: | 1979 (setq outline-during-write-cue nil)) |
1686 (if (and (listp buffer-undo-list) ; Undo history being kept. | 1980 ;; Undo bunching business: |
1687 (equal this-command 'self-insert-command) | 1981 (if (and (listp buffer-undo-list) ; Undo history being kept. |
1688 (equal last-command 'self-insert-command)) | 1982 (equal this-command 'self-insert-command) |
1689 (let* ((prev-stuff (cdr buffer-undo-list)) | 1983 (equal last-command 'self-insert-command)) |
1690 (before-prev-stuff (cdr (cdr prev-stuff))) | 1984 (let* ((prev-stuff (cdr buffer-undo-list)) |
1691 cur-cell cur-from cur-to | 1985 (before-prev-stuff (cdr (cdr prev-stuff))) |
1692 prev-cell prev-from prev-to) | 1986 cur-cell cur-from cur-to |
1693 (if (and before-prev-stuff ; Goes back far enough to bother, | 1987 prev-cell prev-from prev-to) |
1694 (not (car prev-stuff)) ; and break before current, | 1988 (if (and before-prev-stuff ; Goes back far enough to bother, |
1695 (not (car before-prev-stuff)) ; !and break before prev! | 1989 (not (car prev-stuff)) ; and break before current, |
1696 (setq prev-cell (car (cdr prev-stuff))) ; contents now, | 1990 (not (car before-prev-stuff)) ; !and break before prev! |
1697 (setq cur-cell (car buffer-undo-list)) ; contents prev. | 1991 (setq prev-cell (car (cdr prev-stuff))) ; contents now, |
1698 | 1992 (setq cur-cell (car buffer-undo-list)) ; contents prev. |
1699 ;; cur contents denote a single char insertion: | 1993 |
1700 (numberp (setq cur-from (car cur-cell))) | 1994 ;; cur contents denote a single char insertion: |
1701 (numberp (setq cur-to (cdr cur-cell))) | 1995 (numberp (setq cur-from (car cur-cell))) |
1702 (= 1 (- cur-to cur-from)) | 1996 (numberp (setq cur-to (cdr cur-cell))) |
1703 | 1997 (= 1 (- cur-to cur-from)) |
1704 ;; prev contents denote fewer than aggregate-limit | 1998 |
1705 ;; insertions: | 1999 ;; prev contents denote fewer than aggregate-limit |
1706 (numberp (setq prev-from (car prev-cell))) | 2000 ;; insertions: |
1707 (numberp (setq prev-to (cdr prev-cell))) | 2001 (numberp (setq prev-from (car prev-cell))) |
2002 (numberp (setq prev-to (cdr prev-cell))) | |
1708 ; Below threshold: | 2003 ; Below threshold: |
1709 (> outline-undo-aggregation (- prev-to prev-from))) | 2004 (> outline-undo-aggregation (- prev-to prev-from))) |
1710 (setq buffer-undo-list | 2005 (setq buffer-undo-list |
1711 (cons (cons prev-from cur-to) | 2006 (cons (cons prev-from cur-to) |
1712 (cdr (cdr (cdr buffer-undo-list)))))))) | 2007 (cdr (cdr (cdr buffer-undo-list)))))))) |
1713 ;; Implement -post-goto-bullet, if set: (must be after undo business) | 2008 ;; Implement -post-goto-bullet, if set: (must be after undo business) |
1714 (if (and outline-post-goto-bullet | 2009 (if (and outline-post-goto-bullet |
1715 (outline-current-bullet-pos)) | 2010 (outline-current-bullet-pos)) |
1716 (progn (goto-char (outline-current-bullet-pos)) | 2011 (progn (goto-char (outline-current-bullet-pos)) |
1717 (setq outline-post-goto-bullet nil))) | 2012 (setq outline-post-goto-bullet nil))) |
1718 ))) | 2013 )) |
1719 ;;;_ > outline-pre-command-business () | 2014 ;;;_ > outline-pre-command-business () |
1720 (defun outline-pre-command-business () | 2015 (defun outline-pre-command-business () |
1721 "A pre-command-hook function for outline buffers. Implements | 2016 "Outline pre-command-hook function for outline buffers. |
1722 special behavior when cursor is on bullet char. | 2017 |
2018 Implements special behavior when cursor is on bullet char. | |
1723 | 2019 |
1724 Self-insert characters are reinterpreted control-character references | 2020 Self-insert characters are reinterpreted control-character references |
1725 into the outline-mode-map. The outline-mode post-command hook will | 2021 into the outline-mode-map. The outline-mode post-command hook will |
1726 position a cursor that has moved as a result of such reinterpretation, | 2022 position a cursor that has moved as a result of such reinterpretation, |
1727 on the destination topic's bullet, when the cursor wound up in the | 2023 on the destination topic's bullet, when the cursor wound up in the |
1729 The upshot is that you can get easy, single (unmodified) key outline | 2025 The upshot is that you can get easy, single (unmodified) key outline |
1730 maneuvering and general operations by positioning the cursor on the | 2026 maneuvering and general operations by positioning the cursor on the |
1731 bullet char, and it continues until you deliberately some non-outline | 2027 bullet char, and it continues until you deliberately some non-outline |
1732 motion command to relocate the cursor off of a bullet char." | 2028 motion command to relocate the cursor off of a bullet char." |
1733 | 2029 |
1734 (if (and (eq this-command 'self-insert-command) | 2030 (if (and (boundp 'outline-mode) |
2031 outline-mode | |
2032 (eq this-command 'self-insert-command) | |
1735 (eq (point)(outline-current-bullet-pos))) | 2033 (eq (point)(outline-current-bullet-pos))) |
1736 | 2034 |
1737 (let* ((this-key-num (if (numberp last-command-event) | 2035 (let* ((this-key-num (if (numberp last-command-event) |
1738 last-command-event)) | 2036 last-command-event)) |
1739 mapped-binding) | 2037 mapped-binding) |
1750 (concat outline-command-prefix | 2048 (concat outline-command-prefix |
1751 (char-to-string (- this-key-num 64)))))) | 2049 (char-to-string (- this-key-num 64)))))) |
1752 (if mapped-binding | 2050 (if mapped-binding |
1753 (setq outline-post-goto-bullet t | 2051 (setq outline-post-goto-bullet t |
1754 this-command mapped-binding))))) | 2052 this-command mapped-binding))))) |
2053 ;;;_ > outline-find-file-hook () | |
2054 (defun outline-find-file-hook () | |
2055 "Activate outline-mode when `outline-auto-activation' & `outline-layout' are non-nil. | |
2056 | |
2057 See `outline-init' for setup instructions." | |
2058 (if (and outline-auto-activation | |
2059 (not (outline-mode-p)) | |
2060 outline-layout) | |
2061 (outline-mode t))) | |
2062 ;;;_ : Establish the hooks | |
2063 (add-hook 'post-command-hook 'outline-post-command-business) | |
2064 (add-hook 'pre-command-hook 'outline-pre-command-business) | |
1755 | 2065 |
1756 ;;;_ - Topic Format Assessment | 2066 ;;;_ - Topic Format Assessment |
1757 ;;;_ > outline-solicit-alternate-bullet (depth &optional current-bullet) | 2067 ;;;_ > outline-solicit-alternate-bullet (depth &optional current-bullet) |
1758 (defun outline-solicit-alternate-bullet (depth &optional current-bullet) | 2068 (defun outline-solicit-alternate-bullet (depth &optional current-bullet) |
1759 | 2069 |
1760 "Prompt for and return a bullet char as an alternative to the | 2070 "Prompt for and return a bullet char as an alternative to the current one. |
1761 current one. Offer one suitable for current depth DEPTH as default." | 2071 |
2072 Offer one suitable for current depth DEPTH as default." | |
1762 | 2073 |
1763 (let* ((default-bullet (or current-bullet | 2074 (let* ((default-bullet (or current-bullet |
1764 (outline-bullet-for-depth depth))) | 2075 (outline-bullet-for-depth depth))) |
1765 (sans-escapes (regexp-sans-escapes outline-bullets-string)) | 2076 (sans-escapes (regexp-sans-escapes outline-bullets-string)) |
1766 (choice (solicit-char-in-string | 2077 (choice (solicit-char-in-string |
1803 (if prefix | 2114 (if prefix |
1804 (outline-get-prefix-bullet prefix) | 2115 (outline-get-prefix-bullet prefix) |
1805 (outline-get-bullet))))) | 2116 (outline-get-bullet))))) |
1806 ;;;_ > outline-bullet-for-depth (&optional depth) | 2117 ;;;_ > outline-bullet-for-depth (&optional depth) |
1807 (defun outline-bullet-for-depth (&optional depth) | 2118 (defun outline-bullet-for-depth (&optional depth) |
1808 "Return outline topic bullet suited to DEPTH, or for current depth if none | 2119 "Return outline topic bullet suited to optional DEPTH, or current depth." |
1809 specified." | |
1810 ;; Find bullet in plain-bullets-string modulo DEPTH. | 2120 ;; Find bullet in plain-bullets-string modulo DEPTH. |
1811 (if outline-stylish-prefixes | 2121 (if outline-stylish-prefixes |
1812 (char-to-string (aref outline-plain-bullets-string | 2122 (char-to-string (aref outline-plain-bullets-string |
1813 (% (max 0 (- depth 2)) | 2123 (% (max 0 (- depth 2)) |
1814 outline-plain-bullets-string-len))) | 2124 outline-plain-bullets-string-len))) |
1826 ;; Depth null means use current depth, non-null means we're either | 2136 ;; Depth null means use current depth, non-null means we're either |
1827 ;; opening a new topic after current topic, lower or higher, or we're | 2137 ;; opening a new topic after current topic, lower or higher, or we're |
1828 ;; changing level of current topic. | 2138 ;; changing level of current topic. |
1829 ;; Solicit dominates specified bullet-char. | 2139 ;; Solicit dominates specified bullet-char. |
1830 ;;;_ . Doc string: | 2140 ;;;_ . Doc string: |
1831 "Generate a topic prefix suitable for optional arg DEPTH, or current | 2141 "Generate a topic prefix suitable for optional arg DEPTH, or current depth. |
1832 depth if not specified. | |
1833 | 2142 |
1834 All the arguments are optional. | 2143 All the arguments are optional. |
1835 | 2144 |
1836 PRIOR-BULLET indicates the bullet of the prefix being changed, or | 2145 PRIOR-BULLET indicates the bullet of the prefix being changed, or |
1837 nil if none. This bullet may be preserved (other options | 2146 nil if none. This bullet may be preserved (other options |
1913 | 2222 |
1914 ;; Numbering invoked through args: | 2223 ;; Numbering invoked through args: |
1915 ((and outline-numbered-bullet number-control) | 2224 ((and outline-numbered-bullet number-control) |
1916 (if (setq numbering (not (setq denumbering (not index)))) | 2225 (if (setq numbering (not (setq denumbering (not index)))) |
1917 outline-numbered-bullet | 2226 outline-numbered-bullet |
1918 (if (and current-bullet | 2227 (if (and prior-bullet |
1919 (not (string= outline-numbered-bullet | 2228 (not (string= outline-numbered-bullet |
1920 current-bullet))) | 2229 prior-bullet))) |
1921 current-bullet | 2230 prior-bullet |
1922 (outline-bullet-for-depth depth)))) | 2231 (outline-bullet-for-depth depth)))) |
1923 | 2232 |
1924 ;;; Neither soliciting nor controlled numbering ;;; | 2233 ;;; Neither soliciting nor controlled numbering ;;; |
1925 ;;; (may be controlled denumbering, tho) ;;; | 2234 ;;; (may be controlled denumbering, tho) ;;; |
1926 | 2235 |
1962 ((outline-sibling-index)))))) | 2271 ((outline-sibling-index)))))) |
1963 ) | 2272 ) |
1964 ) | 2273 ) |
1965 ;;;_ > outline-open-topic (relative-depth &optional before) | 2274 ;;;_ > outline-open-topic (relative-depth &optional before) |
1966 (defun outline-open-topic (relative-depth &optional before) | 2275 (defun outline-open-topic (relative-depth &optional before) |
1967 "Open a new topic at depth DEPTH. New topic is situated after current | 2276 "Open a new topic at depth DEPTH. |
1968 one, unless optional flag BEFORE is non-nil, or unless current line | 2277 |
1969 is complete empty (not even whitespace), in which case open is done | 2278 New topic is situated after current one, unless optional flag BEFORE |
1970 on current line. | 2279 is non-nil, or unless current line is complete empty (not even |
2280 whitespace), in which case open is done on current line. | |
1971 | 2281 |
1972 Nuances: | 2282 Nuances: |
1973 | 2283 |
1974 - Creation of new topics is with respect to the visible topic | 2284 - Creation of new topics is with respect to the visible topic |
1975 containing the cursor, regardless of intervening concealed ones. | 2285 containing the cursor, regardless of intervening concealed ones. |
2133 prior to the current one." | 2443 prior to the current one." |
2134 (interactive "p") | 2444 (interactive "p") |
2135 (outline-open-topic 1 (> 0 arg))) | 2445 (outline-open-topic 1 (> 0 arg))) |
2136 ;;;_ > outline-open-sibtopic (arg) | 2446 ;;;_ > outline-open-sibtopic (arg) |
2137 (defun outline-open-sibtopic (arg) | 2447 (defun outline-open-sibtopic (arg) |
2138 "Open new topic header at same level as the current one. Negative | 2448 "Open new topic header at same level as the current one. |
2139 universal arg means to place the new topic prior to the current | 2449 |
2450 Negative universal arg means to place the new topic prior to the current | |
2140 one." | 2451 one." |
2141 (interactive "p") | 2452 (interactive "p") |
2142 (outline-open-topic 0 (> 0 arg))) | 2453 (outline-open-topic 0 (> 0 arg))) |
2143 ;;;_ > outline-open-supertopic (arg) | 2454 ;;;_ > outline-open-supertopic (arg) |
2144 (defun outline-open-supertopic (arg) | 2455 (defun outline-open-supertopic (arg) |
2145 "Open new topic header at shallower level than the current one. | 2456 "Open new topic header at shallower level than the current one. |
2457 | |
2146 Negative universal arg means to open shallower, but place the new | 2458 Negative universal arg means to open shallower, but place the new |
2147 topic prior to the current one." | 2459 topic prior to the current one." |
2148 | 2460 |
2149 (interactive "p") | 2461 (interactive "p") |
2150 (outline-open-topic -1 (> 0 arg))) | 2462 (outline-open-topic -1 (> 0 arg))) |
2154 ;;;_ = outline-former-auto-filler | 2466 ;;;_ = outline-former-auto-filler |
2155 (defvar outline-former-auto-filler nil | 2467 (defvar outline-former-auto-filler nil |
2156 "Name of modal fill function being wrapped by outline-auto-fill.") | 2468 "Name of modal fill function being wrapped by outline-auto-fill.") |
2157 ;;;_ > outline-auto-fill () | 2469 ;;;_ > outline-auto-fill () |
2158 (defun outline-auto-fill () | 2470 (defun outline-auto-fill () |
2159 "Do normal autofill, maintaining outline hanging topic indentation | 2471 "Outline-mode autofill function. |
2160 if outline-use-hanging-indents is set." | 2472 |
2473 Maintains outline hanging topic indentation if | |
2474 `outline-use-hanging-indents' is set." | |
2161 (let ((fill-prefix (if outline-use-hanging-indents | 2475 (let ((fill-prefix (if outline-use-hanging-indents |
2162 ;; Check for topic header indentation: | 2476 ;; Check for topic header indentation: |
2163 (save-excursion | 2477 (save-excursion |
2164 (beginning-of-line) | 2478 (beginning-of-line) |
2165 (if (looking-at outline-regexp) | 2479 (if (looking-at outline-regexp) |
2210 ;; beyond the old margin: | 2524 ;; beyond the old margin: |
2211 (delete-region old-indent-begin old-indent-end) | 2525 (delete-region old-indent-begin old-indent-end) |
2212 (indent-to (+ new-margin excess))))))))) | 2526 (indent-to (+ new-margin excess))))))))) |
2213 ;;;_ > outline-rebullet-current-heading (arg) | 2527 ;;;_ > outline-rebullet-current-heading (arg) |
2214 (defun outline-rebullet-current-heading (arg) | 2528 (defun outline-rebullet-current-heading (arg) |
2215 "Like non-interactive version 'outline-rebullet-heading', but work on | 2529 "Like non-interactive version 'outline-rebullet-heading'. |
2216 \(only) visible heading containing point. | 2530 |
2531 But \(only\) affects visible heading containing point. | |
2217 | 2532 |
2218 With repeat count, solicit for bullet." | 2533 With repeat count, solicit for bullet." |
2219 (interactive "P") | 2534 (interactive "P") |
2220 (save-excursion (outline-back-to-current-heading) | 2535 (save-excursion (outline-back-to-current-heading) |
2221 (outline-end-of-prefix) | 2536 (outline-end-of-prefix) |
2322 ) ; let* ((current-depth (outline-depth))...) | 2637 ) ; let* ((current-depth (outline-depth))...) |
2323 ) ; defun | 2638 ) ; defun |
2324 ;;;_ > outline-rebullet-topic (arg) | 2639 ;;;_ > outline-rebullet-topic (arg) |
2325 (defun outline-rebullet-topic (arg) | 2640 (defun outline-rebullet-topic (arg) |
2326 "Like outline-rebullet-topic-grunt, but start from topic visible at point. | 2641 "Like outline-rebullet-topic-grunt, but start from topic visible at point. |
2642 | |
2327 Descends into invisible as well as visible topics, however. | 2643 Descends into invisible as well as visible topics, however. |
2328 | 2644 |
2329 With repeat count, shift topic depth by that amount." | 2645 With repeat count, shift topic depth by that amount." |
2330 (interactive "P") | 2646 (interactive "P") |
2331 (let ((start-col (current-column)) | 2647 (let ((start-col (current-column)) |
2427 (outline-rebullet-heading nil nil nil nil t))))) | 2743 (outline-rebullet-heading nil nil nil nil t))))) |
2428 ) | 2744 ) |
2429 ) | 2745 ) |
2430 ;;;_ > outline-renumber-to-depth (&optional depth) | 2746 ;;;_ > outline-renumber-to-depth (&optional depth) |
2431 (defun outline-renumber-to-depth (&optional depth) | 2747 (defun outline-renumber-to-depth (&optional depth) |
2432 "Renumber siblings at current depth, from point, and shallower | 2748 "Renumber siblings at current depth. |
2433 if optional arg DEPTH is less than current depth. | 2749 |
2750 Affects superior topics if optional arg DEPTH is less than current depth. | |
2434 | 2751 |
2435 Returns final depth." | 2752 Returns final depth." |
2436 | 2753 |
2437 ;; Proceed by level, processing subsequent siblings on each, | 2754 ;; Proceed by level, processing subsequent siblings on each, |
2438 ;; ascending until we get shallower than the start depth: | 2755 ;; ascending until we get shallower than the start depth: |
2484 nil) ;;; do-successors | 2801 nil) ;;; do-successors |
2485 (if index (setq index (1+ index))) | 2802 (if index (setq index (1+ index))) |
2486 (setq more (outline-next-sibling depth nil)))))) | 2803 (setq more (outline-next-sibling depth nil)))))) |
2487 ;;;_ > outline-shift-in (arg) | 2804 ;;;_ > outline-shift-in (arg) |
2488 (defun outline-shift-in (arg) | 2805 (defun outline-shift-in (arg) |
2489 "Decrease prefix depth of current heading and any topics collapsed | 2806 "Increase depth of current heading and any topics collapsed within it." |
2490 within it." | |
2491 (interactive "p") | 2807 (interactive "p") |
2492 (outline-rebullet-topic arg)) | 2808 (outline-rebullet-topic arg)) |
2493 ;;;_ > outline-shift-out (arg) | 2809 ;;;_ > outline-shift-out (arg) |
2494 (defun outline-shift-out (arg) | 2810 (defun outline-shift-out (arg) |
2495 "Decrease prefix depth of current heading and any topics collapsed | 2811 "Decrease depth of current heading and any topics collapsed within it." |
2496 within it." | |
2497 (interactive "p") | 2812 (interactive "p") |
2498 (outline-rebullet-topic (* arg -1))) | 2813 (outline-rebullet-topic (* arg -1))) |
2499 ;;;_ : Surgery (kill-ring) functions with special provisions for outlines: | 2814 ;;;_ : Surgery (kill-ring) functions with special provisions for outlines: |
2500 ;;;_ > outline-kill-line (&optional arg) | 2815 ;;;_ > outline-kill-line (&optional arg) |
2501 (defun outline-kill-line (&optional arg) | 2816 (defun outline-kill-line (&optional arg) |
2553 (outline-renumber-to-depth depth)))) | 2868 (outline-renumber-to-depth depth)))) |
2554 ;;;_ > outline-yank-processing () | 2869 ;;;_ > outline-yank-processing () |
2555 (defun outline-yank-processing (&optional arg) | 2870 (defun outline-yank-processing (&optional arg) |
2556 | 2871 |
2557 "Incidental outline-specific business to be done just after text yanks. | 2872 "Incidental outline-specific business to be done just after text yanks. |
2873 | |
2558 Does depth adjustment of yanked topics, when: | 2874 Does depth adjustment of yanked topics, when: |
2559 | 2875 |
2560 1 the stuff being yanked starts with a valid outline header prefix, and | 2876 1 the stuff being yanked starts with a valid outline header prefix, and |
2561 2 it is being yanked at the end of a line which consists of only a valid | 2877 2 it is being yanked at the end of a line which consists of only a valid |
2562 topic prefix. | 2878 topic prefix. |
2677 (message "")))) | 2993 (message "")))) |
2678 (if (not resituate) | 2994 (if (not resituate) |
2679 (exchange-point-and-mark)))) | 2995 (exchange-point-and-mark)))) |
2680 ;;;_ > outline-yank (&optional arg) | 2996 ;;;_ > outline-yank (&optional arg) |
2681 (defun outline-yank (&optional arg) | 2997 (defun outline-yank (&optional arg) |
2682 "Like yank, with depth and numbering adjustment of yanked topics in | 2998 "Outline-mode yank, with depth and numbering adjustment of yanked topics. |
2683 outline mode. Non-topic yanks work no differntly than normal yanks. | 2999 |
3000 Non-topic yanks work no differntly than normal yanks. | |
2684 | 3001 |
2685 If a topic is being yanked into a bare topic prefix, the depth of the | 3002 If a topic is being yanked into a bare topic prefix, the depth of the |
2686 yanked topic is adjusted to the depth of the topic prefix. | 3003 yanked topic is adjusted to the depth of the topic prefix. |
2687 | 3004 |
2688 1 we're yanking in an outline-mode buffer | 3005 1 we're yanking in an outline-mode buffer |
2710 (yank arg) | 3027 (yank arg) |
2711 (if (outline-mode-p) | 3028 (if (outline-mode-p) |
2712 (outline-yank-processing))) | 3029 (outline-yank-processing))) |
2713 ;;;_ > outline-yank-pop (&optional arg) | 3030 ;;;_ > outline-yank-pop (&optional arg) |
2714 (defun outline-yank-pop (&optional arg) | 3031 (defun outline-yank-pop (&optional arg) |
2715 "Just like yank-pop, but works like outline-yank when popping | 3032 "Yank-pop like outline-yank when popping to bare outline prefixes. |
2716 topics just after fresh outline prefixes. Adapts level of popped | 3033 |
2717 stuff to level of fresh prefix. | 3034 Adapts level of popped topics to level of fresh prefix. |
2718 | 3035 |
2719 Note - prefix changes to distinctive bullets will stick, if followed | 3036 Note - prefix changes to distinctive bullets will stick, if followed |
2720 by pops to non-distinctive yanks. Bug..." | 3037 by pops to non-distinctive yanks. Bug..." |
2721 | 3038 |
2722 (interactive "*p") | 3039 (interactive "*p") |
2727 | 3044 |
2728 ;;;_ - Specialty bullet functions | 3045 ;;;_ - Specialty bullet functions |
2729 ;;;_ : File Cross references | 3046 ;;;_ : File Cross references |
2730 ;;;_ > outline-resolve-xref () | 3047 ;;;_ > outline-resolve-xref () |
2731 (defun outline-resolve-xref () | 3048 (defun outline-resolve-xref () |
2732 "Pop to file associated with current heading, if it has an xref bullet | 3049 "Pop to file associated with current heading, if it has an xref bullet. |
2733 \(according to setting of 'outline-file-xref-bullet')." | 3050 |
3051 \(Works according to setting of `outline-file-xref-bullet')." | |
2734 (interactive) | 3052 (interactive) |
2735 (if (not outline-file-xref-bullet) | 3053 (if (not outline-file-xref-bullet) |
2736 (error | 3054 (error |
2737 "outline cross references disabled - no 'outline-file-xref-bullet'") | 3055 "outline cross references disabled - no 'outline-file-xref-bullet'") |
2738 (if (not (string= (outline-current-bullet) outline-file-xref-bullet)) | 3056 (if (not (string= (outline-current-bullet) outline-file-xref-bullet)) |
2766 (error "%s not found" file-name)) | 3084 (error "%s not found" file-name)) |
2767 ) | 3085 ) |
2768 ) | 3086 ) |
2769 ) | 3087 ) |
2770 ) | 3088 ) |
2771 ;;;_ > outline-to-entry-end - Unmaintained compatability - ignore this! | 3089 |
2772 ;------------------------------------------------------------------- | 3090 ;;;_ #6 Exposure Control and Processing |
2773 ; Something added solely for use by a "smart menu" package someone got | |
2774 ; off the net. I have no idea whether this is appropriate code. | |
2775 | |
2776 (defvar next-entry-exists nil "Used by outline-to-entry-end, dunno why.") | |
2777 (defun outline-to-entry-end (&optional include-sub-entries curr-entry-level) | |
2778 "Go to end of whole entry if optional INCLUDE-SUB-ENTRIES is non-nil. | |
2779 CURR-ENTRY-LEVEL is an integer representing the length of the current level | |
2780 string which matched to 'outline-regexp'. If INCLUDE-SUB-ENTRIES is nil, | |
2781 CURR-ENTRY-LEVEL is not needed." | |
2782 (while (and (setq next-entry-exists | |
2783 (re-search-forward outline-regexp nil t)) | |
2784 include-sub-entries | |
2785 (save-excursion | |
2786 (beginning-of-line) | |
2787 (> (outline-depth) curr-entry-level)))) | |
2788 (if next-entry-exists | |
2789 (progn (beginning-of-line) (point)) | |
2790 (goto-char (point-max)))) | |
2791 | |
2792 ;;; Outline topic prefix and level adjustment funcs: | |
2793 | |
2794 ;;;_ #5 Exposure Control and Processing | |
2795 | 3091 |
2796 ;;;_ - Fundamental | 3092 ;;;_ - Fundamental |
2797 ;;;_ > outline-flag-region (from to flag) | 3093 ;;;_ > outline-flag-region (from to flag) |
2798 (defmacro outline-flag-region (from to flag) | 3094 (defmacro outline-flag-region (from to flag) |
2799 "Hides or shows lines from FROM to TO, according to | 3095 "Hide or show lines from FROM to TO, via emacs selective-display FLAG char. |
2800 emacs selective-display FLAG char. Ie, text following flag C-m | 3096 Ie, text following flag C-m \(carriage-return) is hidden until the |
2801 \(carriage-return) is hidden until the next C-j (newline) char. | 3097 next C-j (newline) char. |
2802 | 3098 |
2803 Returns nil iff no changes were effected." | 3099 Returns the endpoint of the region." |
2804 (` (let ((buffer-read-only nil) | 3100 (` (let ((buffer-read-only nil) |
2805 (outline-override-protect t)) | 3101 (outline-override-protect t)) |
2806 (subst-char-in-region (, from) (, to) | 3102 (subst-char-in-region (, from) (, to) |
2807 (if (= (, flag) ?\n) ?\r ?\n) | 3103 (if (= (, flag) ?\n) ?\r ?\n) |
2808 (, flag) t)))) | 3104 (, flag) t)))) |
2809 ;;;_ > outline-flag-current-subtree (flag) | 3105 ;;;_ > outline-flag-current-subtree (flag) |
2810 (defun outline-flag-current-subtree (flag) | 3106 (defun outline-flag-current-subtree (flag) |
3107 "Hide or show subtree of currently-visible topic. | |
3108 | |
3109 See `outline-flag-region' for more details." | |
3110 | |
2811 (save-excursion | 3111 (save-excursion |
2812 (outline-back-to-current-heading) | 3112 (outline-back-to-current-heading) |
2813 (outline-flag-region (point) | 3113 (outline-flag-region (point) |
2814 (progn (outline-end-of-current-subtree) (1- (point))) | 3114 (progn (outline-end-of-current-subtree) (1- (point))) |
2815 flag))) | 3115 flag))) |
2816 | 3116 |
2817 ;;;_ - Mapping and processing of topics | 3117 ;;;_ - Mapping and processing of topics |
2818 ;;;_ " See also chart functions, in navigation | 3118 ;;;_ " See also chart functions, in navigation |
2819 ;;;_ > outline-listify-exposed (&optional start end) | 3119 ;;;_ > outline-listify-exposed (&optional start end) |
2820 (defun outline-listify-exposed (&optional start end) | 3120 (defun outline-listify-exposed (&optional start end) |
2821 | 3121 |
2822 "Produce a list representing exposed topics in current region. | 3122 "Produce a list representing exposed topics in current region. |
3123 | |
2823 This list can then be used by 'outline-process-exposed' to manipulate | 3124 This list can then be used by 'outline-process-exposed' to manipulate |
2824 the subject region. | 3125 the subject region. |
2825 | 3126 |
2826 List is composed of elements that may themselves be lists representing | 3127 List is composed of elements that may themselves be lists representing |
2827 exposed components in subtopic. | 3128 exposed components in subtopic. |
2878 result))) | 3179 result))) |
2879 ;; Put the list with first at front, to last at back: | 3180 ;; Put the list with first at front, to last at back: |
2880 (nreverse result)))) | 3181 (nreverse result)))) |
2881 ;;;_ > outline-process-exposed (arg &optional tobuf) | 3182 ;;;_ > outline-process-exposed (arg &optional tobuf) |
2882 (defun outline-process-exposed (&optional func from to frombuf tobuf) | 3183 (defun outline-process-exposed (&optional func from to frombuf tobuf) |
2883 "Apply FUNCTION \(default 'outline-insert-listified) to exposed | 3184 "Map function on exposed parts of current topic; results to another buffer. |
3185 | |
3186 Apply FUNCTION \(default 'outline-insert-listified) to exposed | |
2884 portions FROM position TO position \(default region, or the entire | 3187 portions FROM position TO position \(default region, or the entire |
2885 buffer if no region active) in buffer FROMBUF \(default current | 3188 buffer if no region active) in buffer FROMBUF \(default current |
2886 buffer) to buffer TOBUF \(default is buffer named like frombuf but | 3189 buffer) to buffer TOBUF \(default is buffer named like frombuf but |
2887 with \"*\" prepended and \" exposed*\" appended). | 3190 with \"*\" prepended and \" exposed*\" appended). |
2888 | 3191 |
2929 | 3232 |
2930 ;;;_ - Topic-specific | 3233 ;;;_ - Topic-specific |
2931 ;;;_ > outline-show-entry () | 3234 ;;;_ > outline-show-entry () |
2932 ; outline-show-entry basically for isearch dynamic exposure, as is... | 3235 ; outline-show-entry basically for isearch dynamic exposure, as is... |
2933 (defun outline-show-entry () | 3236 (defun outline-show-entry () |
2934 "Like outline-show-current-entry, but reveals an entry that is nested | 3237 "Like `outline-show-current-entry', reveals entries nested in hidden topics. |
2935 within hidden topics. | |
2936 | 3238 |
2937 This is a way to give restricted peek at a concealed locality without the | 3239 This is a way to give restricted peek at a concealed locality without the |
2938 expense of exposing its context, but can leave the outline with aberrant | 3240 expense of exposing its context, but can leave the outline with aberrant |
2939 exposure. outline-hide-current-entry-completely or outline-show-offshoot | 3241 exposure. outline-hide-current-entry-completely or outline-show-offshoot |
2940 should be used after the peek to rectify the exposure." | 3242 should be used after the peek to rectify the exposure." |
2947 ?\n))) | 3249 ?\n))) |
2948 ;;;_ > outline-show-children (&optional level strict) | 3250 ;;;_ > outline-show-children (&optional level strict) |
2949 (defun outline-show-children (&optional level strict) | 3251 (defun outline-show-children (&optional level strict) |
2950 | 3252 |
2951 "If point is visible, show all direct subheadings of this heading. | 3253 "If point is visible, show all direct subheadings of this heading. |
3254 | |
2952 Otherwise, do outline-show-to-offshoot, and then show subheadings. | 3255 Otherwise, do outline-show-to-offshoot, and then show subheadings. |
2953 | 3256 |
2954 Optional LEVEL specifies how many levels below the current level | 3257 Optional LEVEL specifies how many levels below the current level |
2955 should be shown, or all levels if t. Default is 1. | 3258 should be shown, or all levels if t. Default is 1. |
2956 | 3259 |
2957 Optional STRICT means don't resort to -show-to-offshoot, no matter | 3260 Optional STRICT means don't resort to -show-to-offshoot, no matter |
2958 what. This is basically so -show-to-offshoot, which is called by | 3261 what. This is basically so -show-to-offshoot, which is called by |
2959 this function, can employ the pure offspring-revealing capabilities of | 3262 this function, can employ the pure offspring-revealing capabilities of |
2960 it." | 3263 it. |
3264 | |
3265 Returns point at end of subtree that was opened, if any. (May get a | |
3266 point of non-opened subtree?)" | |
2961 | 3267 |
2962 (interactive "p") | 3268 (interactive "p") |
2963 (if (and (not strict) | 3269 (let (max-pos) |
2964 (outline-hidden-p)) | 3270 (if (and (not strict) |
2965 | 3271 (outline-hidden-p)) |
2966 (progn (outline-show-to-offshoot) ; Point's concealed, open to expose it. | 3272 |
2967 ;; Then recurse, but with "strict" set so we don't | 3273 (progn (outline-show-to-offshoot) ; Point's concealed, open to |
2968 ;; infinite regress: | 3274 ; expose it. |
2969 (outline-show-children level t)) | 3275 ;; Then recurse, but with "strict" set so we don't |
2970 | 3276 ;; infinite regress: |
2971 (save-excursion | 3277 (setq max-pos (outline-show-children level t))) |
2972 (save-restriction | 3278 |
2973 (let* ((start-pt (point)) | 3279 (save-excursion |
2974 (chart (outline-chart-subtree)) | 3280 (save-restriction |
2975 (e-o-subtree (point)) | 3281 (let* ((start-pt (point)) |
2976 (to-reveal (outline-chart-to-reveal chart (or level 1)))) | 3282 (chart (outline-chart-subtree (or level 1))) |
2977 (goto-char start-pt) | 3283 (to-reveal (outline-chart-to-reveal chart (or level 1)))) |
2978 (if (and strict (= (preceding-char) ?\r)) | 3284 (goto-char start-pt) |
2979 ;; Concealed root would already have been taken care of, | 3285 (if (and strict (= (preceding-char) ?\r)) |
2980 ;; unless strict was set. | 3286 ;; Concealed root would already have been taken care of, |
2981 (outline-flag-region (point) (outline-snug-back) ?\n)) | 3287 ;; unless strict was set. |
2982 (while to-reveal | 3288 (outline-flag-region (point) (outline-snug-back) ?\n)) |
2983 (goto-char (car to-reveal)) | 3289 (while to-reveal |
2984 (outline-flag-region (point) (outline-snug-back) ?\n) | 3290 (goto-char (car to-reveal)) |
2985 (setq to-reveal (cdr to-reveal)))))))) | 3291 (outline-flag-region (point) (outline-snug-back) ?\n) |
3292 (setq to-reveal (cdr to-reveal))))))))) | |
2986 ;;;_ x outline-show-current-children (&optional level strict) | 3293 ;;;_ x outline-show-current-children (&optional level strict) |
2987 (defun outline-show-current-children (&optional level strict) | 3294 (defun outline-show-current-children (&optional level strict) |
2988 "This command was misnamed, 'outline-show-children' is the proper | 3295 "This command was misnamed, use `outline-show-children' instead. |
2989 name. Use it instead. | |
2990 | 3296 |
2991 \(The \"current\" in the name is supposed to imply that it works on | 3297 \(The \"current\" in the name is supposed to imply that it works on |
2992 the visible topic containing point, while it really works with respect | 3298 the visible topic containing point, while it really works with respect |
2993 to the most immediate topic, concealed or not. I'll leave this old | 3299 to the most immediate topic, concealed or not. I'll leave this old |
2994 name around for a bit, but i'll soon activate an annoying message to | 3300 name around for a bit, but i'll soon activate an annoying message to |
3001 ;; "outline-show-current-children" | 3307 ;; "outline-show-current-children" |
3002 ;; (buffer-name (current-buffer)))) | 3308 ;; (buffer-name (current-buffer)))) |
3003 (outline-show-children level strict)) | 3309 (outline-show-children level strict)) |
3004 ;;;_ > outline-hide-point-reconcile () | 3310 ;;;_ > outline-hide-point-reconcile () |
3005 (defun outline-hide-reconcile () | 3311 (defun outline-hide-reconcile () |
3006 "Like outline-hide-current-entry, but hides completely if contained within | 3312 "Like `outline-hide-current-entry'; hides completely if within hidden region. |
3007 hidden region. | |
3008 | 3313 |
3009 Specifically intended for aberrant exposure states, like entries that were | 3314 Specifically intended for aberrant exposure states, like entries that were |
3010 exposed by outline-show-entry but are within otherwise concealed regions." | 3315 exposed by outline-show-entry but are within otherwise concealed regions." |
3011 (interactive) | 3316 (interactive) |
3012 (save-excursion | 3317 (save-excursion |
3017 (point) | 3322 (point) |
3018 (1- (point)))) | 3323 (1- (point)))) |
3019 ?\r))) | 3324 ?\r))) |
3020 ;;;_ > outline-show-to-offshoot () | 3325 ;;;_ > outline-show-to-offshoot () |
3021 (defun outline-show-to-offshoot () | 3326 (defun outline-show-to-offshoot () |
3022 "Like outline-show-entry, but reveals opens all concealed ancestors, | 3327 "Like outline-show-entry, but reveals opens all concealed ancestors, as well. |
3023 as well. | 3328 |
3024 | 3329 As with outline-hide-current-entry-completely, useful for rectifying |
3025 Like outline-hide-current-entry-completely, useful for rectifying aberrant | 3330 aberrant exposure states produced by outline-show-entry." |
3026 exposure states produced by outline-show-entry." | |
3027 | 3331 |
3028 (interactive) | 3332 (interactive) |
3029 (save-excursion | 3333 (save-excursion |
3030 (let ((orig-pt (point)) | 3334 (let ((orig-pt (point)) |
3031 (orig-pref (outline-goto-prefix)) | 3335 (orig-pref (outline-goto-prefix)) |
3044 (message "%s: %s" | 3348 (message "%s: %s" |
3045 "outline-show-to-offshoot: " | 3349 "outline-show-to-offshoot: " |
3046 "Aberrant nesting encountered."))) | 3350 "Aberrant nesting encountered."))) |
3047 (outline-show-children) | 3351 (outline-show-children) |
3048 (goto-char orig-pref)) | 3352 (goto-char orig-pref)) |
3049 (goto-char orig-pt) | 3353 (goto-char orig-pt))) |
3050 (outline-show-entry)))) | 3354 (if (outline-hidden-p) |
3355 (outline-show-entry))) | |
3051 ;;;_ > outline-hide-current-entry () | 3356 ;;;_ > outline-hide-current-entry () |
3052 (defun outline-hide-current-entry () | 3357 (defun outline-hide-current-entry () |
3053 "Hide the body directly following this heading." | 3358 "Hide the body directly following this heading." |
3054 (interactive) | 3359 (interactive) |
3055 (outline-back-to-current-heading) | 3360 (outline-back-to-current-heading) |
3058 (progn (outline-end-of-current-entry) (point)) | 3363 (progn (outline-end-of-current-entry) (point)) |
3059 ?\^M))) | 3364 ?\^M))) |
3060 ;;;_ > outline-show-current-entry (&optional arg) | 3365 ;;;_ > outline-show-current-entry (&optional arg) |
3061 (defun outline-show-current-entry (&optional arg) | 3366 (defun outline-show-current-entry (&optional arg) |
3062 | 3367 |
3063 "Show body following current heading, or hide the entry if repeat | 3368 "Show body following current heading, or hide the entry if repeat count." |
3064 count." | |
3065 | 3369 |
3066 (interactive "P") | 3370 (interactive "P") |
3067 (if arg | 3371 (if arg |
3068 (outline-hide-current-entry) | 3372 (outline-hide-current-entry) |
3069 (save-excursion | 3373 (save-excursion |
3070 (outline-flag-region (point) | 3374 (outline-flag-region (point) |
3071 (progn (outline-end-of-current-entry) (point)) | 3375 (progn (outline-end-of-current-entry) (point)) |
3072 ?\n)))) | 3376 ?\n)))) |
3073 ;;;_ > outline-hide-current-entry-completely () | 3377 ;;;_ > outline-hide-current-entry-completely () |
3074 ; ... outline-hide-current-entry-completely also for isearch dynamic exposure: | 3378 ; ... outline-hide-current-entry-completely also for isearch dynamic exposure: |
3075 (defun outline-hide-current-entry-completely () | 3379 (defun outline-hide-current-entry-completely () |
3076 "Like outline-hide-current-entry, but conceal topic completely. | 3380 "Like outline-hide-current-entry, but conceal topic completely. |
3077 | 3381 |
3084 (progn (outline-pre-next-preface) | 3388 (progn (outline-pre-next-preface) |
3085 (if (= ?\r (following-char)) | 3389 (if (= ?\r (following-char)) |
3086 (point) | 3390 (point) |
3087 (1- (point)))) | 3391 (1- (point)))) |
3088 ?\r))) | 3392 ?\r))) |
3089 ;;;_ > outline-show-current-subtree () | 3393 ;;;_ > outline-show-current-subtree (&optional arg) |
3090 (defun outline-show-current-subtree () | 3394 (defun outline-show-current-subtree (&optional arg) |
3091 "Show everything after this heading at deeper levels." | 3395 "Show everything within the current topic. With a repeat-count, |
3092 (interactive) | 3396 expose this topic and its' siblings." |
3093 (outline-flag-current-subtree ?\n)) | 3397 (interactive "P") |
3398 (save-excursion | |
3399 (if (<= (outline-current-depth) 0) | |
3400 ;; Outside any topics - try to get to the first: | |
3401 (if (not (outline-next-heading)) | |
3402 (error "No topics.") | |
3403 ;; got to first, outermost topic - set to expose it and siblings: | |
3404 (message "Above outermost topic - exposing all.") | |
3405 (outline-flag-region (point-min)(point-max) ?\n)) | |
3406 (if (not arg) | |
3407 (outline-flag-current-subtree ?\n) | |
3408 (outline-beginning-of-level) | |
3409 (outline-expose-topic '(* :)))))) | |
3094 ;;;_ > outline-hide-current-subtree (&optional just-close) | 3410 ;;;_ > outline-hide-current-subtree (&optional just-close) |
3095 (defun outline-hide-current-subtree (&optional just-close) | 3411 (defun outline-hide-current-subtree (&optional just-close) |
3096 | 3412 "Close the current topic, or containing topic if this one is already closed. |
3097 "Hide everything after this heading at deeper levels, or if it's | 3413 |
3098 already closed, and optional arg JUST-CLOSE is nil, hide the current | 3414 If this topic is closed and it's a top level topic, close this topic |
3099 level." | 3415 and its' siblings. |
3416 | |
3417 If optional arg JUST-CLOSE is non-nil, do not treat the parent or | |
3418 siblings, even if the target topic is already closed." | |
3100 | 3419 |
3101 (interactive) | 3420 (interactive) |
3102 (let ((orig-eol (save-excursion | 3421 (let ((from (point)) |
3103 (end-of-line)(outline-goto-prefix)(end-of-line)(point)))) | 3422 (orig-eol (progn (end-of-line) |
3423 (if (not (outline-goto-prefix)) | |
3424 (error "No topics found.") | |
3425 (end-of-line)(point))))) | |
3104 (outline-flag-current-subtree ?\^M) | 3426 (outline-flag-current-subtree ?\^M) |
3105 (if (and (= orig-eol (save-excursion (goto-char orig-eol) | 3427 (goto-char from) |
3106 (end-of-line) | 3428 (if (and (= orig-eol (progn (goto-char orig-eol) |
3107 (point))) | 3429 (end-of-line) |
3430 (point))) | |
3431 (not just-close) | |
3108 ;; Structure didn't change - try hiding current level: | 3432 ;; Structure didn't change - try hiding current level: |
3109 (if (not just-close) | 3433 (goto-char from) |
3110 (outline-up-current-level 1 t))) | 3434 (if (outline-up-current-level 1 t) |
3111 (outline-hide-current-subtree)))) | 3435 t |
3436 (goto-char 0) | |
3437 (let ((msg | |
3438 "Top-level topic already closed - closing siblings...")) | |
3439 (message msg) | |
3440 (outline-expose-topic '(0 :)) | |
3441 (message (concat msg " Done."))) | |
3442 nil) | |
3443 (/= (outline-recent-depth) 0)) | |
3444 (outline-hide-current-subtree)) | |
3445 (goto-char from))) | |
3112 ;;;_ > outline-show-current-branches () | 3446 ;;;_ > outline-show-current-branches () |
3113 (defun outline-show-current-branches () | 3447 (defun outline-show-current-branches () |
3114 "Show all subheadings of this heading, but not their bodies." | 3448 "Show all subheadings of this heading, but not their bodies." |
3115 (interactive) | 3449 (interactive) |
3116 (beginning-of-line) | 3450 (beginning-of-line) |
3126 ;;;_ - Region and beyond | 3460 ;;;_ - Region and beyond |
3127 ;;;_ > outline-show-all () | 3461 ;;;_ > outline-show-all () |
3128 (defun outline-show-all () | 3462 (defun outline-show-all () |
3129 "Show all of the text in the buffer." | 3463 "Show all of the text in the buffer." |
3130 (interactive) | 3464 (interactive) |
3131 (outline-flag-region (point-min) (point-max) ?\n)) | 3465 (message "Exposing entire buffer...") |
3466 (outline-flag-region (point-min) (point-max) ?\n) | |
3467 (message "Exposing entire buffer... Done.")) | |
3132 ;;;_ > outline-hide-bodies () | 3468 ;;;_ > outline-hide-bodies () |
3133 (defun outline-hide-bodies () | 3469 (defun outline-hide-bodies () |
3134 "Hide all of buffer except headings." | 3470 "Hide all of buffer except headings." |
3135 (interactive) | 3471 (interactive) |
3136 (outline-hide-region-body (point-min) (point-max))) | 3472 (outline-hide-region-body (point-min) (point-max))) |
3146 (progn (outline-pre-next-preface) (point)) ?\^M) | 3482 (progn (outline-pre-next-preface) (point)) ?\^M) |
3147 (if (not (eobp)) | 3483 (if (not (eobp)) |
3148 (forward-char | 3484 (forward-char |
3149 (if (looking-at "[\n\r][\n\r]") | 3485 (if (looking-at "[\n\r][\n\r]") |
3150 2 1))))))) | 3486 2 1))))))) |
3151 ;;;_ > outline-expose-topic (spec &optional prev-spec) | 3487 |
3152 (defun outline-expose-topic (spec &optional prev-spec) | 3488 ;;;_ > outline-expose-topic (spec) |
3153 | 3489 (defun outline-expose-topic (spec) |
3154 "Dictate wholesale exposure scheme for current level. | 3490 "Apply exposure specs to successive outline topic items. |
3155 | 3491 |
3156 Unless you want the args to be evaluated, you probably want to use the | 3492 Use the more convenient frontend, `outline-new-exposure', if you don't |
3157 frontend `outline-new-exposure', instead. | 3493 need evaluation of the arguments, or even better, the `outline-layout' |
3494 variable-keyed mode-activation/auto-exposure feature of allout outline | |
3495 mode. See the respective documentation strings for more details. | |
3158 | 3496 |
3159 Cursor is left at start position. | 3497 Cursor is left at start position. |
3160 | 3498 |
3161 SPEC is either a number or, recursively, a list. | 3499 SPEC is either a number or a list. |
3500 | |
3501 Successive specs on a list are applied to successive sibling topics. | |
3162 | 3502 |
3163 A simple spec \(either a number, one of a few symbols, or the null | 3503 A simple spec \(either a number, one of a few symbols, or the null |
3164 list) dictates the overall exposure for the current topic. | 3504 list) dictates the exposure for the corresponding topic. |
3165 | 3505 |
3166 Non null lists are complex specs, designating exposure for the current | 3506 Non-null lists recursively designate exposure specs for respective |
3167 topic and its respective siblings. The ':' repeat spec is used to | 3507 subtopics of the current topic. |
3168 specify exposure for any number of successive siblings, up to the | 3508 |
3169 trailing ones for which there are explicit specs following the ':'. | 3509 The ':' repeat spec is used to specify exposure for any number of |
3510 successive siblings, up to the trailing ones for which there are | |
3511 explicit specs following the ':'. | |
3170 | 3512 |
3171 Simple (numeric and null-list) specs are interpreted as follows: | 3513 Simple (numeric and null-list) specs are interpreted as follows: |
3172 | 3514 |
3173 - Numbers indicate the relative depth to open the corresponding topic. | 3515 Numbers indicate the relative depth to open the corresponding topic. |
3174 - negative numbers force the topic to be closed before opening to the | 3516 - negative numbers force the topic to be closed before opening to the |
3175 absolute value of the number, so all siblings are open only to | 3517 absolute value of the number, so all siblings are open only to |
3176 that level. | 3518 that level. |
3177 - positive numbers open to the relative depth indicated by the | 3519 - positive numbers open to the relative depth indicated by the |
3178 number, but do not force already opened subtopics to be closed. | 3520 number, but do not force already opened subtopics to be closed. |
3179 - 0 means to close topic - hide all offspring. | 3521 - 0 means to close topic - hide all offspring. |
3180 - ':' 'repeat' | 3522 : - 'repeat' |
3181 apply prior element to all siblings at current level, *up to* | 3523 apply prior element to all siblings at current level, *up to* |
3182 those siblings that would be covered by specs following the ':' | 3524 those siblings that would be covered by specs following the ':' |
3183 on the list. Ie, apply to all topics at level but the last | 3525 on the list. Ie, apply to all topics at level but the last |
3184 ones. \(Only first of multiple colons at same level is | 3526 ones. \(Only first of multiple colons at same level is |
3185 respected - subsequent ones are discarded.) | 3527 respected - subsequent ones are discarded.) |
3186 - '*' completely opens the topic, including bodies. | 3528 * - completely opens the topic, including bodies. |
3187 - '+' shows all the sub headers, but not the bodies | 3529 + - shows all the sub headers, but not the bodies |
3188 - '-' exposes the body and immediate offspring of the corresponding topic. | 3530 - - exposes the body of the corresponding topic. |
3189 | |
3190 If the spec is a list, the first element must be a number, which | |
3191 dictates the exposure depth of the topic as a whole. Subsequent | |
3192 elements of the list are nested SPECs, dictating the specific exposure | |
3193 for the corresponding offspring of the topic. | |
3194 | 3531 |
3195 Examples: | 3532 Examples: |
3196 \(outline-expose-topic '(-1 : 0)) | 3533 \(outline-expose-topic '(-1 : 0)) |
3197 Close this and all following topics at current level, exposing | 3534 Close this and all following topics at current level, exposing |
3198 only their immediate children, but close down the last topic | 3535 only their immediate children, but close down the last topic |
3199 at this current level completely. | 3536 at this current level completely. |
3200 \(outline-expose-topic '(-1 () : 1 0)) | 3537 \(outline-expose-topic '(-1 () : 1 0)) |
3201 Close current topic so only the immediate subtopics are shown; | 3538 Close current topic so only the immediate subtopics are shown; |
3202 show the children in the second to last topic, and completely | 3539 show the children in the second to last topic, and completely |
3203 close the last one. | 3540 close the last one. |
3204 \(outline-expose-topic -2 ': -1 '*)) | 3541 \(outline-expose-topic '(-2 : -1 *)) |
3205 Expose children and grandchildren of all topics at current | 3542 Expose children and grandchildren of all topics at current |
3206 level except the last two; expose children of the second to | 3543 level except the last two; expose children of the second to |
3207 last and completely open the last one." | 3544 last and completely open the last one." |
3208 | 3545 |
3209 (interactive "xExposure spec: ") | 3546 (interactive "xExposure spec: ") |
3210 (let ((depth (outline-current-depth)) | 3547 (if (not (listp spec)) |
3211 done | 3548 nil |
3212 max-pos) | 3549 (let ((depth (outline-depth)) |
3213 (cond ((null spec) nil) | 3550 (max-pos 0) |
3214 ((symbolp spec) | 3551 prev-elem curr-elem |
3215 (cond ((eq spec '*) (outline-show-current-subtree)) | 3552 stay done |
3216 ((eq spec '+) (outline-show-current-branches)) | 3553 snug-back |
3217 ((eq spec '-) (outline-show-current-entry)) | 3554 ) |
3218 ((eq spec ':) | 3555 (while spec |
3219 ;; Whoops. ':' should have been caught at superior | 3556 (setq prev-elem curr-elem |
3220 ;; level. | 3557 curr-elem (car spec) |
3221 (error | 3558 spec (cdr spec)) |
3222 "outline-expose-topic: improper exposure spec - bare ':'")))) | 3559 (cond ; Do current element: |
3223 ((numberp spec) | 3560 ((null curr-elem) nil) |
3224 (if (>= 0 spec) | 3561 ((symbolp curr-elem) |
3225 (save-excursion (outline-hide-current-subtree t) | 3562 (cond ((eq curr-elem '*) (outline-show-current-subtree) |
3226 (end-of-line) | 3563 (if (> outline-recent-end-of-subtree max-pos) |
3227 (if (or (not max-pos) | 3564 (setq max-pos outline-recent-end-of-subtree))) |
3228 (> (point) max-pos)) | 3565 ((eq curr-elem '+) (outline-show-current-branches) |
3229 (setq max-pos (point))) | 3566 (if (> outline-recent-end-of-subtree max-pos) |
3230 (if (> 0 spec) | 3567 (setq max-pos outline-recent-end-of-subtree))) |
3231 (setq spec (* -1 spec))))) | 3568 ((eq curr-elem '-) (outline-show-current-entry)) |
3232 (if (> spec 0) | 3569 ((eq curr-elem ':) |
3233 (outline-show-children spec))) | 3570 (setq stay t) |
3234 ((listp spec) | 3571 ;; Expand the 'repeat' spec to an explicit version, |
3235 (if (eq (car spec) ':) | 3572 ;; w.r.t. remaining siblings: |
3236 (setq spec | 3573 (let ((residue ; = # of sibs not covered by remaining spec |
3237 ;; Expand the 'repeat' spec to an explicit version, | 3574 ;; Dang - could be nice to make use of the chart, sigh: |
3238 ;; w.r.t. remaining siblings: | 3575 (- (length (outline-chart-siblings)) |
3239 (let* (;; Assign rest-spec to preserve first elem in cdr. | 3576 (length spec)))) |
3240 (rest-spec (delq ': (cdr spec))) | 3577 (if (< 0 residue) |
3241 ;; residue: # of sibs not covered by remaining spec | 3578 ;; Some residue - cover it with prev-elem: |
3242 (residue (- (length (outline-chart-siblings)) | 3579 (setq spec (append (make-list residue prev-elem) |
3243 (length rest-spec)))) | 3580 spec))))))) |
3244 (if (>= 0 residue) | 3581 ((numberp curr-elem) |
3245 ;; remaining spec covers all - just use it: | 3582 (if (and (>= 0 curr-elem) (outline-visible-p)) |
3246 rest-spec | 3583 (save-excursion (outline-hide-current-subtree t) |
3247 ;; cover residue by prev-spec, rest by rest-spec: | 3584 (if (> 0 curr-elem) |
3248 (nconc (make-list residue prev-spec) rest-spec))))) | 3585 nil |
3249 (setq max-pos (or (outline-expose-topic (car spec) prev-spec) | 3586 (if (> outline-recent-end-of-subtree max-pos) |
3250 max-pos)) | 3587 (setq max-pos |
3251 (setq prev-spec (car spec)) | 3588 outline-recent-end-of-subtree))))) |
3252 (setq spec (cdr spec)) | 3589 (if (> (abs curr-elem) 0) |
3253 (and | 3590 (progn (outline-show-children (abs curr-elem)) |
3254 (if max-pos | 3591 (if (> outline-recent-end-of-subtree max-pos) |
3255 ;; Capitalize on max-pos state to get us nearer next sibling: | 3592 (setq max-pos outline-recent-end-of-subtree))))) |
3256 (progn (goto-char (min (point-max) max-pos)) | 3593 ((listp curr-elem) |
3257 (outline-next-heading)) | 3594 (if (outline-descend-to-depth (1+ depth)) |
3258 (outline-next-sibling depth)) | 3595 (let ((got (outline-expose-topic curr-elem))) |
3259 (let ((got (outline-expose-topic spec prev-spec))) | 3596 (if (and got (> got max-pos)) (setq max-pos got)))))) |
3260 (if (and got (or (not max-pos) (> got max-pos))) | 3597 (cond (stay (setq stay nil)) |
3261 (setq max-pos got)))))) | 3598 ((listp (car spec)) nil) |
3262 max-pos)) | 3599 ((> max-pos (point)) |
3600 ;; Capitalize on max-pos state to get us nearer next sibling: | |
3601 (progn (goto-char (min (point-max) max-pos)) | |
3602 (outline-next-heading))) | |
3603 ((outline-next-sibling depth)))) | |
3604 max-pos))) | |
3263 ;;;_ > outline-old-expose-topic (spec &rest followers) | 3605 ;;;_ > outline-old-expose-topic (spec &rest followers) |
3264 (defun outline-old-expose-topic (spec &rest followers) | 3606 (defun outline-old-expose-topic (spec &rest followers) |
3265 | 3607 |
3266 "Dictate wholesale exposure scheme for current topic, according to SPEC. | 3608 "Deprecated. Use outline-expose-topic \(with different schema |
3609 format\) instead. | |
3610 | |
3611 Dictate wholesale exposure scheme for current topic, according to SPEC. | |
3267 | 3612 |
3268 SPEC is either a number or a list. Optional successive args | 3613 SPEC is either a number or a list. Optional successive args |
3269 dictate exposure for subsequent siblings of current topic. | 3614 dictate exposure for subsequent siblings of current topic. |
3270 | 3615 |
3271 A simple spec (either a number, a special symbol, or the null list) | 3616 A simple spec (either a number, a special symbol, or the null list) |
3336 (setq followers (cdr followers))) | 3681 (setq followers (cdr followers))) |
3337 max-pos)) | 3682 max-pos)) |
3338 ;;;_ > outline-new-exposure '() | 3683 ;;;_ > outline-new-exposure '() |
3339 (defmacro outline-new-exposure (&rest spec) | 3684 (defmacro outline-new-exposure (&rest spec) |
3340 "Literal frontend for `outline-expose-topic', doesn't evaluate arguments. | 3685 "Literal frontend for `outline-expose-topic', doesn't evaluate arguments. |
3341 All arguments that would need to be quoted in outline-expose-topic need not | 3686 Some arguments that would need to be quoted in outline-expose-topic |
3342 be in outline-exposure. | 3687 need not be quoted in outline-new-exposure. |
3343 | 3688 |
3344 Cursor is left at start position. | 3689 Cursor is left at start position. |
3345 | 3690 |
3346 Use this instead of obsolete 'outline-exposure'. | 3691 Use this instead of obsolete 'outline-exposure'. |
3347 | 3692 |
3359 level, and expose children of subsequent topics at current | 3704 level, and expose children of subsequent topics at current |
3360 level *except* for the last, which should be opened completely." | 3705 level *except* for the last, which should be opened completely." |
3361 (list 'save-excursion | 3706 (list 'save-excursion |
3362 '(if (not (or (outline-goto-prefix) | 3707 '(if (not (or (outline-goto-prefix) |
3363 (outline-next-heading))) | 3708 (outline-next-heading))) |
3364 (error "outline-exposure: Can't find any outline topics.")) | 3709 (error "outline-new-exposure: Can't find any outline topics.")) |
3365 (list 'outline-expose-topic (list 'quote spec)))) | 3710 (list 'outline-expose-topic (list 'quote spec)))) |
3366 ;;;_ > outline-exposure '() | 3711 ;;;_ > outline-exposure '() |
3367 (defmacro outline-exposure (&rest spec) | 3712 (defmacro outline-exposure (&rest spec) |
3368 "Being deprecated - use more recent 'outline-new-exposure' instead. | 3713 "Being deprecated - use more recent 'outline-new-exposure' instead. |
3369 | 3714 |
3374 (outline-next-heading))) | 3719 (outline-next-heading))) |
3375 (error "Can't find any outline topics.")) | 3720 (error "Can't find any outline topics.")) |
3376 (cons 'outline-old-expose-topic | 3721 (cons 'outline-old-expose-topic |
3377 (mapcar '(lambda (x) (list 'quote x)) spec)))) | 3722 (mapcar '(lambda (x) (list 'quote x)) spec)))) |
3378 | 3723 |
3379 ;;;_ #6 Search with Dynamic Exposure (requires v19 isearch or isearch-mode) | 3724 ;;;_ #7 ISearch with Dynamic Exposure |
3380 ;;;_ = outline-search-reconceal | 3725 ;;;_ = outline-search-reconceal |
3381 (defvar outline-search-reconceal nil | 3726 (defvar outline-search-reconceal nil |
3382 "Used for outline isearch provisions, to track whether current search | 3727 "Track whether current search match was concealed outside of search. |
3383 match was concealed outside of search. The value is the location of the | 3728 |
3384 match, if it was concealed, regular if the entire topic was concealed, in | 3729 The value is the location of the match, if it was concealed, regular |
3385 a list if the entry was concealed.") | 3730 if the entire topic was concealed, in a list if the entry was concealed.") |
3386 ;;;_ = outline-search-quitting | 3731 ;;;_ = outline-search-quitting |
3387 (defconst outline-search-quitting nil | 3732 (defconst outline-search-quitting nil |
3388 "Variable used by isearch-terminate/outline-provisions and | 3733 "Distinguishes isearch conclusion and cancellation. |
3389 isearch-done/outline-provisions to distinguish between a conclusion | 3734 |
3390 and cancellation of a search.") | 3735 Used by isearch-terminate/outline-provisions and |
3736 isearch-done/outline-provisions") | |
3391 | 3737 |
3392 | 3738 |
3393 ;;;_ > outline-enwrap-isearch () | 3739 ;;;_ > outline-enwrap-isearch () |
3394 (defun outline-enwrap-isearch () | 3740 (defun outline-enwrap-isearch () |
3395 "Impose isearch-mode wrappers so isearch progressively exposes and | 3741 "Impose outline-mode isearch-mode wrappers for dynamic exposure in isearch. |
3396 reconceals hidden topics when working in outline mode, but works | 3742 |
3397 elsewhere. | 3743 Isearch progressively exposes and reconceals hidden topics when |
3744 working in outline mode, but works normally elsewhere. | |
3398 | 3745 |
3399 The function checks to ensure that the rebindings are done only once." | 3746 The function checks to ensure that the rebindings are done only once." |
3400 | 3747 |
3401 ; Should isearch-mode be employed, | 3748 ; Should isearch-mode be employed, |
3402 (if (or (not outline-enwrap-isearch-mode) | 3749 (if (or (not outline-enwrap-isearch-mode) |
3421 (setq outline-enwrap-isearch-mode nil)))) | 3768 (setq outline-enwrap-isearch-mode nil)))) |
3422 ;; Isearch-mode loaded, encapsulate specific entry points for | 3769 ;; Isearch-mode loaded, encapsulate specific entry points for |
3423 ;; outline dynamic-exposure business: | 3770 ;; outline dynamic-exposure business: |
3424 (progn | 3771 (progn |
3425 | 3772 |
3426 ; stash crucial isearch-mode | 3773 ;; stash crucial isearch-mode funcs under known, private |
3427 ; funcs under known, private | 3774 ;; names, then register wrapper functions under the old |
3428 ; names, then register wrapper | 3775 ;; names, in their stead: 'isearch-quit' is pre isearch v 1.2. |
3429 ; functions under the old | |
3430 ; names, in their stead: | |
3431 ; 'isearch-quit' is pre v 1.2: | |
3432 (fset 'real-isearch-terminate | 3776 (fset 'real-isearch-terminate |
3433 ; 'isearch-quit is pre v 1.2: | 3777 ; 'isearch-quit is pre v 1.2: |
3434 (or (if (fboundp 'isearch-quit) | 3778 (or (if (fboundp 'isearch-quit) |
3435 (symbol-function 'isearch-quit)) | 3779 (symbol-function 'isearch-quit)) |
3436 (if (fboundp 'isearch-abort) | 3780 (if (fboundp 'isearch-abort) |
3443 (fset 'real-isearch-update (symbol-function 'isearch-update)) | 3787 (fset 'real-isearch-update (symbol-function 'isearch-update)) |
3444 (fset 'isearch-update 'isearch-update/outline-provisions) | 3788 (fset 'isearch-update 'isearch-update/outline-provisions) |
3445 (make-variable-buffer-local 'outline-search-reconceal))))) | 3789 (make-variable-buffer-local 'outline-search-reconceal))))) |
3446 ;;;_ > outline-isearch-arrival-business () | 3790 ;;;_ > outline-isearch-arrival-business () |
3447 (defun outline-isearch-arrival-business () | 3791 (defun outline-isearch-arrival-business () |
3448 "Do outline business like exposing current point, if necessary, | 3792 "Do outline business like exposing current point, if necessary. |
3449 registering reconcealment requirements in outline-search-reconceal | 3793 |
3794 Registers reconcealment requirements in outline-search-reconceal | |
3450 accordingly. | 3795 accordingly. |
3451 | 3796 |
3452 Set outline-search-reconceal to nil if current point is not | 3797 Set outline-search-reconceal to nil if current point is not |
3453 concealed, to value of point if entire topic is concealed, and a | 3798 concealed, to value of point if entire topic is concealed, and a |
3454 list containing point if only the topic body is concealed. | 3799 list containing point if only the topic body is concealed. |
3473 ; And reveal the current | 3818 ; And reveal the current |
3474 ; search target: | 3819 ; search target: |
3475 (outline-show-entry))))))) | 3820 (outline-show-entry))))))) |
3476 ;;;_ > outline-isearch-advancing-business () | 3821 ;;;_ > outline-isearch-advancing-business () |
3477 (defun outline-isearch-advancing-business () | 3822 (defun outline-isearch-advancing-business () |
3478 "Do outline business like deexposing current point, if necessary, | 3823 "Do outline business like deexposing current point, if necessary. |
3479 according to reconceal state registration." | 3824 |
3825 Works according to reconceal state registration." | |
3480 (if (and (outline-mode-p) outline-search-reconceal) | 3826 (if (and (outline-mode-p) outline-search-reconceal) |
3481 (save-excursion | 3827 (save-excursion |
3482 (if (listp outline-search-reconceal) | 3828 (if (listp outline-search-reconceal) |
3483 ;; Leave the topic visible: | 3829 ;; Leave the topic visible: |
3484 (progn (goto-char (car outline-search-reconceal)) | 3830 (progn (goto-char (car outline-search-reconceal)) |
3529 ;; isearch-done in newer version of isearch mode takes arg: | 3875 ;; isearch-done in newer version of isearch mode takes arg: |
3530 (real-isearch-done nopush) | 3876 (real-isearch-done nopush) |
3531 (real-isearch-done))) | 3877 (real-isearch-done))) |
3532 ;;;_ > isearch-update/outline-provisions () | 3878 ;;;_ > isearch-update/outline-provisions () |
3533 (defun isearch-update/outline-provisions () | 3879 (defun isearch-update/outline-provisions () |
3534 "Wrapper around isearch which exposes and conceals hidden outline | 3880 "Wrapper dynamically adjusts isearch target exposure. |
3535 portions encountered in the course of searching." | 3881 |
3882 Appropriately exposes and reconceals hidden outline portions, as | |
3883 necessary, in the course of searching." | |
3536 (if (not (and (outline-mode-p) outline-enwrap-isearch-mode)) | 3884 (if (not (and (outline-mode-p) outline-enwrap-isearch-mode)) |
3537 ;; Just do the plain business: | 3885 ;; Just do the plain business: |
3538 (real-isearch-update) | 3886 (real-isearch-update) |
3539 | 3887 |
3540 ;; Ah - provide for outline conditions: | 3888 ;; Ah - provide for outline conditions: |
3541 (outline-isearch-advancing-business) | 3889 (outline-isearch-advancing-business) |
3542 (real-isearch-update) | 3890 (real-isearch-update) |
3543 (cond (isearch-success (outline-isearch-arrival-business)) | 3891 (cond (isearch-success (outline-isearch-arrival-business)) |
3544 ((not isearch-success) (outline-isearch-advancing-business))))) | 3892 ((not isearch-success) (outline-isearch-advancing-business))))) |
3545 | 3893 |
3546 ;;;_ #7 Copying and printing | 3894 ;;;_ #8 Copying and printing |
3547 | 3895 |
3548 ;;;_ - Copy exposed | 3896 ;;;_ - Copy exposed |
3549 ;;;_ > outline-insert-listified (depth prefix bullet text) | 3897 ;;;_ > outline-insert-listified (depth prefix bullet text) |
3550 (defun outline-insert-listified (depth prefix bullet text) | 3898 (defun outline-insert-listified (depth prefix bullet text) |
3899 "Insert contents of listified outline portion in current buffer." | |
3551 (insert-string (concat (if (> depth 1) prefix "") | 3900 (insert-string (concat (if (> depth 1) prefix "") |
3552 (make-string (1- depth) ?\ ) | 3901 (make-string (1- depth) ?\ ) |
3553 bullet)) | 3902 bullet)) |
3554 (while text | 3903 (while text |
3555 (insert-string (car text)) | 3904 (insert-string (car text)) |
3556 (if (setq text (cdr text)) | 3905 (if (setq text (cdr text)) |
3557 (insert-string "\n"))) | 3906 (insert-string "\n"))) |
3558 (insert-string "\n")) | 3907 (insert-string "\n")) |
3559 ;;;_ > outline-copy-exposed (arg &optional tobuf) | 3908 ;;;_ > outline-copy-exposed (arg &optional tobuf) |
3560 (defun outline-copy-exposed (arg &optional tobuf) | 3909 (defun outline-copy-exposed (arg &optional tobuf) |
3561 "Duplicate exposed portions of current topic to buffer with | 3910 "Duplicate exposed portions of current topic to another buffer. |
3562 current buffers' name with \" exposed\" appended to it. | 3911 |
3912 Other buffer has current buffers' name with \" exposed\" appended to it. | |
3563 | 3913 |
3564 With repeat count, copy the exposed portions of entire buffer." | 3914 With repeat count, copy the exposed portions of entire buffer." |
3565 | 3915 |
3566 (interactive "P") | 3916 (interactive "P") |
3567 (if (not tobuf) | 3917 (if (not tobuf) |
3581 (goto-char start-pt))) | 3931 (goto-char start-pt))) |
3582 | 3932 |
3583 ;;;_ - LaTeX formatting | 3933 ;;;_ - LaTeX formatting |
3584 ;;;_ > outline-latex-verb-quote (str &optional flow) | 3934 ;;;_ > outline-latex-verb-quote (str &optional flow) |
3585 (defun outline-latex-verb-quote (str &optional flow) | 3935 (defun outline-latex-verb-quote (str &optional flow) |
3586 "Return copy of STRING which expresses the original characters | 3936 "Return copy of STRING for literal reproduction across latex processing. |
3587 \(including carriage returns) of the string across latex processing." | 3937 Expresses the original characters \(including carriage returns) of the |
3938 string across latex processing." | |
3588 (mapconcat '(lambda (char) | 3939 (mapconcat '(lambda (char) |
3589 ;;;mess: (cond ((memq char '(?"" ?$ ?% ?# ?& ?- ?" ?` ?^ ?- ?*));;;")))) | 3940 ;;;mess: (cond ((memq char '(?"" ?$ ?% ?# ?& ?- ?" ?` ?^ ?- ?*));;;")))) |
3590 (cond ((memq char '(?\\ ?$ ?% ?# ?& ?{ ?} ?_ ?^ ?- ?*)) | 3941 (cond ((memq char '(?\\ ?$ ?% ?# ?& ?{ ?} ?_ ?^ ?- ?*)) |
3591 (concat "\\char" (number-to-string char) "{}")) | 3942 (concat "\\char" (number-to-string char) "{}")) |
3592 ((= char ?\n) "\\\\") | 3943 ((= char ?\n) "\\\\") |
3593 (t (char-to-string char)))) | 3944 (t (char-to-string char)))) |
3594 str | 3945 str |
3595 "")) | 3946 "")) |
3596 ;;;_ > outline-latex-verbatim-quote-curr-line () | 3947 ;;;_ > outline-latex-verbatim-quote-curr-line () |
3597 (defun outline-latex-verbatim-quote-curr-line () | 3948 (defun outline-latex-verbatim-quote-curr-line () |
3598 "Adjust line contents so it is unaltered \(from the original line) | 3949 "Express line for exact \(literal\) representation across latex processing. |
3950 | |
3951 Adjust line contents so it is unaltered \(from the original line) | |
3599 across latex processing, within the context of a 'verbatim' | 3952 across latex processing, within the context of a 'verbatim' |
3600 environment. Leaves point at the end of the line." | 3953 environment. Leaves point at the end of the line." |
3601 (beginning-of-line) | 3954 (beginning-of-line) |
3602 (let ((beg (point)) | 3955 (let ((beg (point)) |
3603 (end (progn (end-of-line)(point)))) | 3956 (end (progn (end-of-line)(point)))) |
3689 "Insert concluding latex commands at point in BUFFER." | 4042 "Insert concluding latex commands at point in BUFFER." |
3690 (set-buffer buf) | 4043 (set-buffer buf) |
3691 (insert "\n\\end{document}\n")) | 4044 (insert "\n\\end{document}\n")) |
3692 ;;;_ > outline-latexify-one-item (depth prefix bullet text) | 4045 ;;;_ > outline-latexify-one-item (depth prefix bullet text) |
3693 (defun outline-latexify-one-item (depth prefix bullet text) | 4046 (defun outline-latexify-one-item (depth prefix bullet text) |
3694 "Insert LaTeX commands for formatting one item - a topic header and | 4047 "Insert LaTeX commands for formatting one outline item. |
3695 its' body - of an outline. Args are the topics' numeric DEPTH, the | 4048 |
3696 header PREFIX lead string, the BULLET string, and a list of TEXT | 4049 Args are the topics' numeric DEPTH, the header PREFIX lead string, the |
3697 strings for the body." | 4050 BULLET string, and a list of TEXT strings for the body." |
3698 (let* ((head-line (if text (car text))) | 4051 (let* ((head-line (if text (car text))) |
3699 (body-lines (cdr text)) | 4052 (body-lines (cdr text)) |
3700 (curr-line) | 4053 (curr-line) |
3701 body-content bop) | 4054 body-content bop) |
3702 ; Do the head line: | 4055 ; Do the head line: |
3739 ;;(insert-string "\\endlines\n") | 4092 ;;(insert-string "\\endlines\n") |
3740 (insert-string "\\end{verbatim}\n") | 4093 (insert-string "\\end{verbatim}\n") |
3741 ))) | 4094 ))) |
3742 ;;;_ > outline-latexify-exposed (arg &optional tobuf) | 4095 ;;;_ > outline-latexify-exposed (arg &optional tobuf) |
3743 (defun outline-latexify-exposed (arg &optional tobuf) | 4096 (defun outline-latexify-exposed (arg &optional tobuf) |
3744 "Copy exposed portions of current topic to TOBUF, formatted for | 4097 "Format current topic's exposed portions to TOBUF for latex processing. |
3745 latex processing. tobuf defaults to a buffer named the same as the | 4098 TOBUF defaults to a buffer named the same as the current buffer, but |
3746 current buffer, but with \"*\" prepended and \" latex-formed*\" | 4099 with \"*\" prepended and \" latex-formed*\" appended. |
3747 appended. | |
3748 | 4100 |
3749 With repeat count, copy the exposed portions of entire buffer." | 4101 With repeat count, copy the exposed portions of entire buffer." |
3750 | 4102 |
3751 (interactive "P") | 4103 (interactive "P") |
3752 (if (not tobuf) | 4104 (if (not tobuf) |
3769 (outline-insert-latex-trailer tobuf) | 4121 (outline-insert-latex-trailer tobuf) |
3770 (goto-char (point-min)) | 4122 (goto-char (point-min)) |
3771 (pop-to-buffer buf) | 4123 (pop-to-buffer buf) |
3772 (goto-char start-pt))) | 4124 (goto-char start-pt))) |
3773 | 4125 |
3774 | 4126 ;;;_ #9 miscellaneous |
3775 ;;;_ #8 miscellaneous | |
3776 ;;;_ > outline-mark-topic () | 4127 ;;;_ > outline-mark-topic () |
3777 (defun outline-mark-topic () | 4128 (defun outline-mark-topic () |
3778 "Put the region around topic currently containing point." | 4129 "Put the region around topic currently containing point." |
3779 (interactive) | 4130 (interactive) |
3780 (beginning-of-line) | 4131 (beginning-of-line) |
3781 (outline-goto-prefix) | 4132 (outline-goto-prefix) |
3782 (push-mark (point)) | 4133 (push-mark (point)) |
3783 (outline-end-of-current-subtree) | 4134 (outline-end-of-current-subtree) |
3784 (exchange-point-and-mark)) | 4135 (exchange-point-and-mark)) |
3785 ;;;_ > outlineify-sticky () | 4136 ;;;_ > outlineify-sticky () |
4137 ;; outlinify-sticky is correct spelling; provide this alias for sticklers: | |
4138 (defalias 'outlinify-sticky 'outlineify-sticky) | |
3786 (defun outlineify-sticky (&optional arg) | 4139 (defun outlineify-sticky (&optional arg) |
3787 "Activate outline mode and establish file eval to set initial exposure. | 4140 "Activate outline mode and establish file var so it is started subseqently. |
3788 | 4141 |
3789 Invoke with a string argument to designate a string to prepend to | 4142 See doc-string for `outline-layout' and `outline-init' for details on |
3790 topic prefixs, or with a universal argument to be prompted for the | 4143 setup for auto-startup." |
3791 string to be used. Suitable defaults are provided for lisp, | 4144 |
3792 emacs-lisp, c, c++, awk, sh, csh, and perl modes." | 4145 (interactive "P") |
3793 | 4146 |
3794 (interactive "P") (outline-mode t) | 4147 (outline-mode t) |
3795 | 4148 |
3796 | 4149 (save-excursion |
3797 (let ((leader-cell (assoc major-mode outline-mode-leaders))) | 4150 (goto-char (point-min)) |
3798 (cond (arg (if (stringp arg) | 4151 (if (looking-at outline-regexp) |
3799 ;; Use arg as the header-prefix: | 4152 t |
3800 (outline-lead-with-comment-string arg) | 4153 (outline-open-topic 2) |
3801 ;; Otherwise, let function solicit string: | 4154 (insert-string (concat "Dummy outline topic header - see" |
3802 (setq arg (outline-lead-with-comment-string)))) | 4155 "`outline-mode' docstring for info.")) |
3803 | 4156 (next-line 1) |
3804 (leader-cell | |
3805 (outline-lead-with-comment-string (cdr leader-cell)) | |
3806 (setq arg (cdr leader-cell))))) | |
3807 | |
3808 (let* ((lead-prefix (format "%s%s" | |
3809 (concat outline-header-prefix (if arg " " "")) | |
3810 outline-primary-bullet)) | |
3811 (lead-line (format "%s%s %s\n%s %s\n %s %s %s" | |
3812 (if arg outline-header-prefix "") | |
3813 outline-primary-bullet | |
3814 "Local emacs vars." | |
3815 "'(This topic sets initial outline exposure" | |
3816 "of the file when loaded by emacs," | |
3817 "Encapsulate it in comments if" | |
3818 "file is a program" | |
3819 "otherwise ignore it,"))) | |
3820 | |
3821 (save-excursion | |
3822 ; Put a topic at the top, if | |
3823 ; none there already: | |
3824 (goto-char (point-min)) | |
3825 (if (not (looking-at outline-regexp)) | |
3826 (insert-string | |
3827 (if (not arg) outline-primary-bullet | |
3828 (format "%s%s\n" outline-header-prefix outline-primary-bullet)))) | |
3829 | |
3830 ; File-vars stuff, at the bottom: | |
3831 (goto-char (point-max)) | 4157 (goto-char (point-max)) |
3832 ; Insert preamble: | 4158 (next-line 1) |
3833 (insert-string (format "\n\n%s\n%s %s %s\n%s %s\n" | 4159 (outline-open-topic 0) |
3834 lead-line | 4160 (insert-string "Local emacs vars.\n") |
3835 lead-prefix | 4161 (outline-open-topic 1) |
3836 "local" | 4162 (insert-string "(`outline-layout' is for allout.el outline-mode)\n") |
3837 "variables:" | 4163 (outline-open-topic 0) |
3838 lead-prefix | 4164 (insert-string "Local variables:\n") |
3839 "eval:")) | 4165 (outline-open-topic 0) |
3840 ; Insert outline-mode activation: | 4166 (insert-string (format "outline-layout: %s\n" |
3841 (insert-string | 4167 (or outline-layout |
3842 (format "\t %s\n\t\t%s\n\t\t\t%s\n" | 4168 '(1 : 0)))) |
3843 "(condition-case err" | 4169 (outline-open-topic 0) |
3844 "(save-excursion" | 4170 (insert-string "End:\n")))) |
3845 "(outline-mode t)")) | |
3846 ; Conditionally insert prefix | |
3847 ; leader customization: | |
3848 (if arg (insert-string (format "\t\t\t(%s \"%s\")\n" | |
3849 "outline-lead-with-comment-string" | |
3850 arg))) | |
3851 ; Insert ammouncement and | |
3852 ; exposure control: | |
3853 (insert-string | |
3854 (format "\t\t\t%s %s\n\t\t\t%s %s\n\t\t%s %s" | |
3855 "(message \"Adjusting '%s' exposure\"" | |
3856 "(buffer-name))" | |
3857 "(goto-char 0)" | |
3858 "(outline-exposure -1 0))" | |
3859 "(error (message " | |
3860 "\"Failed file var 'allout' provisions\")))")) | |
3861 ; Insert postamble: | |
3862 (insert-string (format "\n%s End:\n)\n" | |
3863 lead-prefix))))) | |
3864 ;;;_ > solicit-char-in-string (prompt string &optional do-defaulting) | 4171 ;;;_ > solicit-char-in-string (prompt string &optional do-defaulting) |
3865 (defun solicit-char-in-string (prompt string &optional do-defaulting) | 4172 (defun solicit-char-in-string (prompt string &optional do-defaulting) |
3866 "Solicit (with first arg PROMPT) choice of a character from string STRING. | 4173 "Solicit (with first arg PROMPT) choice of a character from string STRING. |
3867 | 4174 |
3868 Optional arg DO-DEFAULTING indicates to accept empty input (CR)." | 4175 Optional arg DO-DEFAULTING indicates to accept empty input (CR)." |
3898 got) | 4205 got) |
3899 ) | 4206 ) |
3900 ;;;_ > regexp-sans-escapes (string) | 4207 ;;;_ > regexp-sans-escapes (string) |
3901 (defun regexp-sans-escapes (regexp &optional successive-backslashes) | 4208 (defun regexp-sans-escapes (regexp &optional successive-backslashes) |
3902 "Return a copy of REGEXP with all character escapes stripped out. | 4209 "Return a copy of REGEXP with all character escapes stripped out. |
4210 | |
3903 Representations of actual backslashes - '\\\\\\\\' - are left as a | 4211 Representations of actual backslashes - '\\\\\\\\' - are left as a |
3904 single backslash. | 4212 single backslash. |
3905 | 4213 |
3906 Optional arg SUCCESSIVE-BACKSLASHES is used internally for recursion." | 4214 Optional arg SUCCESSIVE-BACKSLASHES is used internally for recursion." |
3907 | 4215 |
3917 ;; Include first char: | 4225 ;; Include first char: |
3918 (concat (substring regexp 0 1) | 4226 (concat (substring regexp 0 1) |
3919 (regexp-sans-escapes (substring regexp 1))) | 4227 (regexp-sans-escapes (substring regexp 1))) |
3920 ;; Exclude first char, but maintain count: | 4228 ;; Exclude first char, but maintain count: |
3921 (regexp-sans-escapes (substring regexp 1) successive-backslashes)))) | 4229 (regexp-sans-escapes (substring regexp 1) successive-backslashes)))) |
3922 ;;;_ - add-hook definition for v18 | 4230 ;;;_ - add-hook definition for divergent emacsen |
3923 ;;;_ > add-hook (hook function &optional append) | 4231 ;;;_ > add-hook (hook function &optional append) |
3924 (if (not (fboundp 'add-hook)) | 4232 (if (not (fboundp 'add-hook)) |
3925 (defun add-hook (hook function &optional append) | 4233 (defun add-hook (hook function &optional append) |
3926 "Add to the value of HOOK the function FUNCTION unless already present (it | 4234 "Add to the value of HOOK the function FUNCTION unless already present. |
3927 becomes the first hook on the list unless optional APPEND is non-nil, in | 4235 \(It becomes the first hook on the list unless optional APPEND is non-nil, in |
3928 which case it becomes the last). HOOK should be a symbol, and FUNCTION may be | 4236 which case it becomes the last). HOOK should be a symbol, and FUNCTION may be |
3929 any valid function. HOOK's value should be a list of functions, not a single | 4237 any valid function. HOOK's value should be a list of functions, not a single |
3930 function. If HOOK is void, it is first set to nil." | 4238 function. If HOOK is void, it is first set to nil." |
3931 (or (boundp hook) (set hook nil)) | 4239 (or (boundp hook) (set hook nil)) |
3932 (or (if (consp function) | 4240 (or (if (consp function) |
3938 (set hook | 4246 (set hook |
3939 (if append | 4247 (if append |
3940 (nconc (symbol-value hook) (list function)) | 4248 (nconc (symbol-value hook) (list function)) |
3941 (cons function (symbol-value hook))))))) | 4249 (cons function (symbol-value hook))))))) |
3942 | 4250 |
3943 ;;;_ #9 Under development | 4251 ;;;_ #10 Under development |
3944 ;;;_ > outline-bullet-isearch (&optional bullet) | 4252 ;;;_ > outline-bullet-isearch (&optional bullet) |
3945 (defun outline-bullet-isearch (&optional bullet) | 4253 (defun outline-bullet-isearch (&optional bullet) |
3946 "Isearch \(regexp\) for topic with bullet BULLET." | 4254 "Isearch \(regexp\) for topic with bullet BULLET." |
3947 (interactive) | 4255 (interactive) |
3948 (if (not bullet) | 4256 (if (not bullet) |
3955 outline-header-prefix | 4263 outline-header-prefix |
3956 "[ \t]*" | 4264 "[ \t]*" |
3957 bullet))) | 4265 bullet))) |
3958 (isearch-repeat 'forward) | 4266 (isearch-repeat 'forward) |
3959 (isearch-mode t))) | 4267 (isearch-mode t))) |
3960 ;;;_ - Re hooking up with isearch - use isearch-op-fun rather than | 4268 ;;;_ ? Re hooking up with isearch - use isearch-op-fun rather than |
3961 wrapping the isearch functions. | 4269 ;;; wrapping the isearch functions. |
3962 | 4270 |
3963 ;;;_* Local emacs vars. | 4271 ;;;_* Local emacs vars. |
3964 '( | 4272 ;;; The following `outline-layout' local variable setting: |
3965 Local variables: | 4273 ;;; - closes all topics from the first topic to just before the third-to-last, |
3966 eval: (save-excursion | 4274 ;;; - shows the children of the third to last (config vars) |
3967 (if (not (condition-case err (outline-mode t) | 4275 ;;; - and the second to last (code section), |
3968 (wrong-number-of-arguments nil))) | 4276 ;;; - and closes the last topic (this local-variables section). |
3969 (progn | 4277 ;;;Local variables: |
3970 (message | 4278 ;;;outline-layout: (0 : -1 -1 0) |
3971 "Allout outline-mode not loaded, not adjusting buffer exposure") | 4279 ;;;End: |
3972 (sit-for 1)) | 4280 |
3973 (message "Adjusting '%s' exposure" (buffer-name)) | 4281 ;; allout.el ends here |
3974 (outline-lead-with-comment-string "\;\;\;_") | 4282 |
3975 (goto-char 0) | |
3976 (outline-new-exposure 0 : -1 -1 0))) | |
3977 End:) | |
3978 |