Mercurial > emacs
annotate lisp/allout.el @ 5616:67a8c4a8c80e
(Ffile_symlink_p): Doc fix.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Sun, 16 Jan 1994 23:59:56 +0000 |
parents | fe3bea12d381 |
children | 3e1323443b1a |
rev | line source |
---|---|
3430 | 1 ;;;_* Allout - An extensive outline-mode for Emacs. |
2 ;;; Note - the lines beginning with ';;;_' are outline topic headers. | |
3 ;;; Load this file (or 'eval-current-buffer') and revisit the | |
4 ;;; file to give it a whirl. | |
5 | |
6 ;;;_ + Provide | |
7 (provide 'outline) | |
8 | |
9 ;;;_ + Package Identification Stuff | |
10 | |
11 ;;;_ - Author: Ken Manheimer <klm@nist.gov> | |
12 ;;;_ - Maintainer: Ken Manheimer <klm@nist.gov> | |
13 ;;;_ - Created: Dec 1991 - first release to usenet | |
5310
fe3bea12d381
(outline-copy-exposed): Don't use replace-regexp.
Richard M. Stallman <rms@gnu.org>
parents:
3591
diff
changeset
|
14 ;;;_ - Version: $Id: allout.el,v 1.3 1993/06/09 11:51:08 jimb Exp $|| |
3430 | 15 ;;;_ - Keywords: outline mode |
16 | |
17 ;;;_ - LCD Archive Entry | |
18 | |
19 ;; LCD Archive Entry: | |
20 ;; allout|Ken Manheimer|klm@nist.gov | |
21 ;; |A more thorough outline-mode | |
5310
fe3bea12d381
(outline-copy-exposed): Don't use replace-regexp.
Richard M. Stallman <rms@gnu.org>
parents:
3591
diff
changeset
|
22 ;; |27-May-1993|$Id: allout.el,v 1.3 1993/06/09 11:51:08 jimb Exp $|| |
3430 | 23 |
24 ;;;_ - Description | |
25 ;; A full-fledged outline mode, based on the original rudimentary | |
26 ;; GNU emacs outline functionality. | |
27 ;; | |
28 ;; Ken Manheimer Nat'l Inst of Standards and Technology | |
29 ;; klm@nist.gov (301)975-3539 (Formerly Nat'l Bureau of Standards) | |
30 ;; NIST Shared File Service Manager and Developer | |
31 | |
32 ;;;_ - Copyright | |
33 ;; Copyright (C) 1992, 1993 Free Software Foundation, Inc. | |
34 | |
35 ;; This file is part of GNU Emacs. | |
36 | |
37 ;; GNU Emacs is distributed in the hope that it will be useful, | |
38 ;; but WITHOUT ANY WARRANTY. No author or distributor | |
39 ;; accepts responsibility to anyone for the consequences of using it | |
40 ;; or for whether it serves any particular purpose or works at all, | |
41 ;; unless he says so in writing. Refer to the GNU Emacs General Public | |
42 ;; License for full details. | |
43 | |
44 ;; Everyone is granted permission to copy, modify and redistribute | |
45 ;; GNU Emacs, but only under the conditions described in the | |
46 ;; GNU Emacs General Public License. A copy of this license is | |
47 ;; supposed to have been given to you along with GNU Emacs so you | |
48 ;; can know your rights and responsibilities. It should be in a | |
49 ;; file named COPYING. Among other things, the copyright notice | |
50 ;; and this notice must be preserved on all copies. | |
51 | |
52 ;;;_ + User Customization variables | |
53 | |
54 ;;;_ - Topic Header configuration | |
55 | |
56 ;;;_ = outline-header-prefix | |
57 (defvar outline-header-prefix "." | |
58 "* Leading string for greater than level 0 topic headers.") | |
59 (make-variable-buffer-local 'outline-header-prefix) | |
60 | |
61 ;;;_ = outline-header-subtraction | |
62 (defvar outline-header-subtraction (1- (length outline-header-prefix)) | |
63 "* Leading string for greater than level 0 topic headers.") | |
64 (make-variable-buffer-local 'outline-header-subtraction) | |
65 | |
66 ;;;_ = outline-primary-bullet | |
67 (defvar outline-primary-bullet "*") ;; Changing this var disables any | |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
3549
diff
changeset
|
68 ;; backwards compatibility with |
3430 | 69 ;; the original outline mode. |
70 (make-variable-buffer-local 'outline-primary-bullet) | |
71 | |
72 ;;;_ = outline-plain-bullets-string | |
73 (defvar outline-plain-bullets-string "" | |
74 "* The bullets normally used in outline topic prefixes. See | |
75 'outline-distinctive-bullets-string' for the other kind of | |
76 bullets. | |
77 | |
78 DO NOT include the close-square-bracket, ']', among any bullets. | |
79 | |
80 You must run 'set-outline-regexp' in order for changes to the | |
81 value of this var to effect outline-mode operation.") | |
82 (setq outline-plain-bullets-string (concat outline-primary-bullet | |
83 "+-:.;,")) | |
84 (make-variable-buffer-local 'outline-plain-bullets-string) | |
85 | |
86 ;;;_ = outline-distinctive-bullets-string | |
87 (defvar outline-distinctive-bullets-string "" | |
88 "* The bullets used for distinguishing outline topics. These | |
89 bullets are not offered among the regular rotation, and are not | |
90 changed when automatically rebulleting, as when shifting the | |
91 level of a topic. See 'outline-plain-bullets-string' for the | |
92 other kind of bullets. | |
93 | |
94 DO NOT include the close-square-bracket, ']', among any bullets. | |
95 | |
96 You must run 'set-outline-regexp' in order for changes | |
97 to the value of this var to effect outline-mode operation.") | |
98 (setq outline-distinctive-bullets-string "=>([{}&!?#%\"X@$~") | |
99 (make-variable-buffer-local 'outline-distinctive-bullets-string) | |
100 | |
101 ;;;_ > outline-numbered-bullet () | |
102 (defvar outline-numbered-bullet () | |
103 "* Bullet signifying outline prefixes which are to be numbered. | |
104 Leave it nil if you don't want any numbering, or set it to a | |
105 string with the bullet you want to be used.") | |
106 (setq outline-numbered-bullet "#") | |
107 (make-variable-buffer-local 'outline-numbered-bullet) | |
108 | |
109 ;;;_ = outline-file-xref-bullet | |
110 (defvar outline-file-xref-bullet "@" | |
111 "* Set this var to the bullet you want to use for file cross-references. | |
112 Set it 'nil' if you want to inhibit this capability.") | |
113 | |
114 ;;;_ - Miscellaneous customization | |
115 | |
116 ;;;_ = outline-stylish-prefixes | |
117 (defvar outline-stylish-prefixes t | |
118 "*A true value for this var makes the topic-prefix creation and modification | |
119 functions vary the prefix bullet char according to level. Otherwise, only | |
120 asterisks ('*') and distinctive bullets are used. | |
121 | |
122 This is how an outline can look with stylish prefixes: | |
123 | |
124 * Top level | |
125 .* A topic | |
126 . + One level 3 subtopic | |
127 . . One level 4 subtopic | |
128 . + Another level 3 subtopic | |
129 . . A level 4 subtopic | |
130 . #2 A distinguished, numbered level 4 subtopic | |
131 . ! A distinguished ('!') level 4 subtopic | |
132 . #4 Another numbered level 4 subtopic | |
133 | |
134 This would be an outline with stylish prefixes inhibited: | |
135 | |
136 * Top level | |
137 .* A topic | |
138 .! A distinctive (but measly) subtopic | |
139 . * A sub-subtopic - no bullets from outline-plain-bullets-string but '*' | |
140 | |
141 Stylish and constant prefixes (as well as old-style prefixes) are | |
142 always respected by the topic maneuvering functions, regardless of | |
143 this variable setting. | |
144 | |
145 The setting of this var is not relevant when outline-old-style-prefixes | |
146 is t.") | |
147 (make-variable-buffer-local 'outline-stylish-prefixes) | |
148 | |
149 ;;;_ = outline-old-style-prefixes | |
150 (defvar outline-old-style-prefixes nil | |
151 "*Setting this var causes the topic-prefix creation and modification | |
152 functions to make only asterix-padded prefixes, so they look exactly | |
153 like the old style prefixes. | |
154 | |
155 Both old and new style prefixes are always respected by the topic | |
156 maneuvering functions.") | |
157 (make-variable-buffer-local 'outline-old-style-prefixes) | |
158 | |
159 ;;;_ = outline-enwrap-isearch-mode | |
160 ; Spiffy dynamic-exposure | |
161 ; during searches requires | |
162 ; Dan LaLiberte's isearch-mode: | |
163 (defvar outline-enwrap-isearch-mode "isearch-mode.el" | |
164 "* Set this var to the name of the (non-compiled) elisp code for | |
165 isearch-mode, if you have Dan LaLiberte's 'isearch-mode' | |
166 stuff and want isearches to reveal hidden stuff encountered in the | |
167 course of a search, and reconceal it if you go past. Set it nil if | |
168 you don't have the package, or don't want to use this feature.") | |
169 | |
170 ;;;_ = outline-use-hanging-indents | |
171 (defvar outline-use-hanging-indents t | |
172 "* Set this var non-nil if you have Kyle E Jones' filladapt stuff, | |
173 and you want outline to fill topics as hanging indents to the | |
174 bullets.") | |
175 (make-variable-buffer-local 'outline-use-hanging-indents) | |
176 | |
177 ;;;_ = outline-reindent-bodies | |
178 (defvar outline-reindent-bodies t | |
179 "* Set this var non-nil if you want topic depth adjustments to | |
180 reindent hanging bodies (ie, bodies lines indented to beginning of | |
181 heading text). The performance hit is small. | |
182 | |
183 Avoid this strenuously when using outline mode on program code. | |
184 It's great for text, though.") | |
185 (make-variable-buffer-local 'outline-reindent-bodies) | |
186 | |
187 ;;;_ = outline-mode-keys | |
188 ;;; You have to restart outline-mode - '(outline-mode t)' - to have | |
189 ;;; any changes take hold. | |
190 (defvar outline-mode-keys () | |
191 "Assoc list of outline-mode-keybindings, for common reference in setting | |
192 up major and minor-mode keybindings.") | |
193 (setq outline-mode-keys | |
194 '( | |
195 ; Motion commands: | |
196 ("\C-c\C-n" outline-next-visible-heading) | |
197 ("\C-c\C-p" outline-previous-visible-heading) | |
198 ("\C-c\C-u" outline-up-current-level) | |
199 ("\C-c\C-f" outline-forward-current-level) | |
200 ("\C-c\C-b" outline-backward-current-level) | |
201 ("\C-c\C-a" outline-beginning-of-current-entry) | |
202 ("\C-c\C-e" outline-end-of-current-entry) | |
203 ; Exposure commands: | |
204 ("\C-c\C-i" outline-show-current-children) | |
205 ("\C-c\C-s" outline-show-current-subtree) | |
206 ("\C-c\C-h" outline-hide-current-subtree) | |
207 ("\C-c\C-o" outline-show-current-entry) | |
208 ("\C-c!" outline-show-all) | |
209 ; Alteration commands: | |
210 ("\C-c " open-sibtopic) | |
211 ("\C-c." open-subtopic) | |
212 ("\C-c," open-supertopic) | |
213 ("\C-c'" outline-shift-in) | |
214 ("\C-c>" outline-shift-in) | |
215 ("\C-c<" outline-shift-out) | |
216 ("\C-c\C-m" outline-rebullet-topic) | |
217 ("\C-cb" outline-rebullet-current-heading) | |
218 ("\C-c#" outline-number-siblings) | |
219 ("\C-k" outline-kill-line) | |
220 ("\C-y" outline-yank) | |
221 ("\M-y" outline-yank-pop) | |
222 ("\C-c\C-k" outline-kill-topic) | |
223 ; Miscellaneous commands: | |
224 ("\C-c@" outline-resolve-xref) | |
225 ("\C-cc" outline-copy-exposed))) | |
226 | |
227 ;;;_ + Code - no user customizations below. | |
228 | |
229 ;;;_ #1 Outline Format and Internal Mode Configuration | |
230 | |
231 ;;;_ : Topic header format | |
232 ;;;_ = outline-regexp | |
233 (defvar outline-regexp "" | |
234 "* Regular expression to match the beginning of a heading line. | |
235 Any line whose beginning matches this regexp is considered a | |
236 heading. This var is set according to the user configuration vars | |
237 by set-outline-regexp.") | |
238 (make-variable-buffer-local 'outline-regexp) | |
239 ;;;_ = outline-bullets-string | |
240 (defvar outline-bullets-string "" | |
241 " A string dictating the valid set of outline topic bullets. This | |
242 var should *not* be set by the user - it is set by 'set-outline-regexp', | |
243 and is composed from the elements of 'outline-plain-bullets-string' | |
244 and 'outline-distinctive-bullets-string'.") | |
245 (make-variable-buffer-local 'outline-bullets-string) | |
246 ;;;_ = outline-line-boundary-regexp | |
247 (defvar outline-line-boundary-regexp () | |
248 " outline-regexp with outline-style beginning of line anchor (ie, | |
249 C-j, *or* C-m, for prefixes of hidden topics). This is properly | |
250 set when outline-regexp is produced by 'set-outline-regexp', so | |
251 that (match-beginning 2) and (match-end 2) delimit the prefix.") | |
252 (make-variable-buffer-local 'outline-line-boundary-regexp) | |
253 ;;;_ = outline-bob-regexp | |
254 (defvar outline-bob-regexp () | |
255 " Like outline-line-boundary-regexp, this is an outline-regexp for | |
256 outline headers at the beginning of the buffer. (match-beginning 2) | |
257 and (match-end 2) | |
258 delimit the prefix.") | |
259 (make-variable-buffer-local 'outline-line-bob-regexp) | |
260 ;;;_ > outline-reset-header-lead (header-lead) | |
261 (defun outline-reset-header-lead (header-lead) | |
262 "* Reset the leading string used to identify topic headers." | |
263 (interactive "sNew lead string: ") | |
264 ;;() | |
265 (setq outline-header-prefix header-lead) | |
266 (setq outline-header-subtraction (1- (length outline-header-prefix))) | |
267 (set-outline-regexp) | |
268 ) | |
269 ;;;_ > outline-lead-with-comment-string (header-lead) | |
270 (defun outline-lead-with-comment-string (&optional header-lead) | |
271 "* Set the topic-header leading string to specified string. Useful | |
272 when for encapsulating outline structure in programming language | |
273 comments. Returns the leading string." | |
274 | |
275 (interactive "P") | |
276 (if (not (stringp header-lead)) | |
277 (setq header-lead (read-string | |
278 "String prefix for topic headers: "))) | |
279 (setq outline-reindent-bodies nil) | |
280 (outline-reset-header-lead header-lead) | |
281 header-lead) | |
282 ;;;_ > set-outline-regexp () | |
283 (defun set-outline-regexp () | |
284 " Generate proper topic-header regexp form for outline functions, from | |
285 outline-plain-bullets-string and outline-distinctive-bullets-string." | |
286 | |
287 (interactive) | |
288 ;; Derive outline-bullets-string from user configured components: | |
289 (setq outline-bullets-string "") | |
290 (let ((strings (list 'outline-plain-bullets-string | |
291 'outline-distinctive-bullets-string)) | |
292 cur-string | |
293 cur-len | |
294 cur-char-string | |
295 index | |
296 new-string) | |
297 (while strings | |
298 (setq new-string "") (setq index 0) | |
299 (setq cur-len (length (setq cur-string (symbol-value (car strings))))) | |
300 (while (< index cur-len) | |
301 (setq cur-char (aref cur-string index)) | |
302 (setq outline-bullets-string | |
303 (concat outline-bullets-string | |
304 (cond | |
305 ; Single dash would denote a | |
306 ; sequence, repeated denotes | |
307 ; a dash: | |
308 ((eq cur-char ?-) "--") | |
309 ; literal close-square-bracket | |
310 ; doesn't work right in the | |
311 ; expr, exclude it: | |
312 ((eq cur-char ?\]) "") | |
313 (t (regexp-quote (char-to-string cur-char)))))) | |
314 (setq index (1+ index))) | |
315 (setq strings (cdr strings))) | |
316 ) | |
317 ;; Derive next for repeated use in outline-pending-bullet: | |
318 (setq outline-plain-bullets-string-len (length outline-plain-bullets-string)) | |
319 (setq outline-header-subtraction (1- (length outline-header-prefix))) | |
320 ;; Produce the new outline-regexp: | |
321 (setq outline-regexp (concat "\\(\\" | |
322 outline-header-prefix | |
323 "[ \t]*[" | |
324 outline-bullets-string | |
325 "]\\)\\|\\" | |
326 outline-primary-bullet | |
327 "+\\|\^l")) | |
328 (setq outline-line-boundary-regexp | |
329 (concat "\\([\C-j\C-m]\\)\\(" outline-regexp "\\)")) | |
330 (setq outline-bob-regexp | |
331 (concat "\\(\\`\\)\\(" outline-regexp "\\)")) | |
332 ) | |
333 | |
334 ;;;_ : Key bindings | |
335 ;;;_ = Generic minor keybindings control | |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
3549
diff
changeset
|
336 ;;;_ ; Stallman's suggestion |
3430 | 337 (defvar outline-mode-map nil "") |
338 | |
339 (if outline-mode-map | |
340 nil | |
341 (setq outline-mode-map (nconc (make-sparse-keymap) text-mode-map)) | |
342 (define-key outline-mode-map "\C-c\C-n" 'outline-next-visible-heading) | |
343 (define-key outline-mode-map "\C-c\C-p" 'outline-previous-visible-heading) | |
344 (define-key outline-mode-map "\C-c\C-i" 'show-children) | |
345 (define-key outline-mode-map "\C-c\C-s" 'show-subtree) | |
346 (define-key outline-mode-map "\C-c\C-h" 'hide-subtree) | |
347 (define-key outline-mode-map "\C-c\C-u" 'outline-up-heading) | |
348 (define-key outline-mode-map "\C-c\C-f" 'outline-forward-same-level) | |
349 (define-key outline-mode-map "\C-c\C-b" 'outline-backward-same-level)) | |
350 | |
351 (defvar outline-minor-mode nil | |
352 "Non-nil if using Outline mode as a minor mode of some other mode.") | |
353 (make-variable-buffer-local 'outline-minor-mode) | |
354 (put 'outline-minor-mode 'permanent-local t) | |
355 (setq minor-mode-alist (append minor-mode-alist | |
356 (list '(outline-minor-mode " Outl")))) | |
357 | |
358 (defvar outline-minor-mode-map nil) | |
359 (if outline-minor-mode-map | |
360 nil | |
361 (setq outline-minor-mode-map (make-sparse-keymap)) | |
362 (define-key outline-minor-mode-map "\C-c" | |
363 (lookup-key outline-mode-map "\C-c"))) | |
364 | |
365 (or (assq 'outline-minor-mode minor-mode-map-alist) | |
366 (setq minor-mode-map-alist | |
367 (cons (cons 'outline-minor-mode outline-minor-mode-map) | |
368 minor-mode-map-alist))) | |
369 | |
370 (defun outline-minor-mode (&optional arg) | |
371 "Toggle Outline minor mode. | |
372 With arg, turn Outline minor mode on if arg is positive, off otherwise. | |
373 See the command `outline-mode' for more information on this mode." | |
374 (interactive "P") | |
375 (setq outline-minor-mode | |
376 (if (null arg) (not outline-minor-mode) | |
377 (> (prefix-numeric-value arg) 0))) | |
378 (if outline-minor-mode | |
379 (progn | |
380 (setq selective-display t) | |
381 (run-hooks 'outline-minor-mode-hook)) | |
382 (setq selective-display nil))) | |
383 ;;;_ ; minor-bind-keys (keys-assoc) | |
384 (defun minor-bind-keys (keys-assoc) | |
385 " Establish BINDINGS assoc list in current buffer, returning a list | |
386 for subsequent use by minor-unbind-keys to resume overloaded local | |
387 bindings." | |
388 (interactive) | |
389 ;; Cycle thru key list, registering prevailing local binding for key, if | |
390 ;; any (for prospective resumption by outline-minor-unbind-keys), then | |
391 ;; overloading it with outline-mode one. | |
392 (let ((local-map (or (current-local-map) | |
393 (make-sparse-keymap))) | |
394 key new-func unbinding-registry prevailing-func) | |
395 (while keys-assoc | |
396 (setq curr-key (car (car keys-assoc))) | |
397 (setq new-func (car (cdr (car keys-assoc)))) | |
398 (setq prevailing-func (local-key-binding curr-key)) | |
399 (if (not (symbolp prevailing-func)) | |
400 (setq prevailing-func nil)) | |
401 ;; Register key being changed, prevailing local binding, & new binding: | |
402 (setq unbinding-registry | |
403 (cons (list curr-key (local-key-binding curr-key) new-func) | |
404 unbinding-registry)) | |
405 ; Make the binding: | |
406 | |
407 (define-key local-map curr-key new-func) | |
408 ; Increment for next iteration: | |
409 (setq keys-assoc (cdr keys-assoc))) | |
410 ; Establish modified map: | |
411 (use-local-map local-map) | |
412 ; Return the registry: | |
413 unbinding-registry) | |
414 ) | |
415 | |
416 ;;;_ ; minor-relinquish-keys (unbinding-registry) | |
417 (defun minor-relinquish-keys (unbinding-registry) | |
418 " Given registry of MODAL-BINDINGS, as produced by minor-bind-keys, | |
419 resume the former local keybindings of those keys that retain the | |
420 local bindings set by minor-bind-keys. Changed local bindings are | |
421 left alone, so other minor (user or modal) bindings are not disrupted. | |
422 | |
423 Returns a list of those registrations which were not, because of | |
424 tampering subsequent to the registration by minor-bind-keys, resumed." | |
425 (interactive) | |
426 (let (residue curr-item curr-key curr-resume curr-relinquish) | |
427 (while unbinding-registry | |
428 (setq curr-item (car unbinding-registry)) | |
429 (setq curr-key (car curr-item)) | |
430 (setq curr-resume (car (cdr curr-item))) | |
431 (setq curr-relinquish (car (cdr (cdr curr-item)))) | |
432 (if (equal (local-key-binding curr-key) curr-relinquish) | |
433 (if curr-resume | |
434 ;; Was a local binding to be resumed - do so: | |
435 (local-set-key curr-key curr-resume) | |
436 (local-unset-key curr-key)) | |
437 ;; Bindings been tampered with since registration - leave it be, and | |
438 ;; register so on residue list: | |
439 (setq residue (cons residue curr-item))) | |
440 (setq unbinding-registry (cdr unbinding-registry))) | |
441 residue) | |
442 ) | |
443 ;;;_ = outline-minor-prior-keys | |
444 (defvar outline-minor-prior-keys () | |
445 "Former key bindings assoc-list, for resumption from outline minor-mode.") | |
446 (make-variable-buffer-local 'outline-minor-prior-keys) | |
447 | |
448 ; Both major and minor mode | |
449 ; bindings are dictated by | |
450 ; this list - put your | |
451 ; settings here. | |
452 ;;;_ > outline-minor-bind-keys () | |
453 (defun outline-minor-bind-keys () | |
454 " Establish outline-mode keybindings as MINOR modality of current buffer." | |
455 (setq outline-minor-prior-keys | |
456 (minor-bind-keys outline-mode-keys))) | |
457 ;;;_ > outline-minor-relinquish-keys () | |
458 (defun outline-minor-relinquish-keys () | |
459 " Resurrect local keybindings as they were before outline-minor-bind-keys." | |
460 (minor-relinquish-keys outline-minor-prior-keys) | |
461 ) | |
462 | |
463 ;;;_ : Mode-Specific Variables Maintenance | |
464 ;;;_ = outline-mode-prior-settings | |
465 (defvar outline-mode-prior-settings nil | |
466 "For internal use by outline mode, registers settings to be resumed | |
467 on mode deactivation.") | |
468 (make-variable-buffer-local 'outline-mode-prior-settings) | |
469 ;;;_ > outline-resumptions (name &optional value) | |
470 (defun outline-resumptions (name &optional value) | |
471 | |
472 " Registers information for later reference, or performs resumption of | |
473 outline-mode specific values. First arg is NAME of variable affected. | |
474 optional second arg is list containing outline-mode-specific VALUE to | |
475 be impose on named variable, and to be registered. (It's a list so you | |
476 can specify registrations of null values.) If no value is specified, | |
477 the registered value is returned (encapsulated in the list, so the | |
478 caller can distinguish nil vs no value), and the registration is popped | |
479 from the list." | |
480 | |
481 (let ((on-list (assq name outline-mode-prior-settings)) | |
482 prior-capsule ; By 'capsule' i mean a list | |
483 ; containing a value, so we can | |
484 ; distinguish nil from no value. | |
485 ) | |
486 | |
487 (if value | |
488 | |
489 ;; Registering: | |
490 (progn | |
491 (if on-list | |
492 nil ; Already preserved prior value - don't mess with it. | |
493 ;; Register the old value, or nil if previously unbound: | |
494 (setq outline-mode-prior-settings | |
495 (cons (list name | |
496 (if (boundp name) (list (symbol-value name)))) | |
497 outline-mode-prior-settings))) | |
498 ; And impose the new value: | |
499 (set name (car value))) | |
500 | |
501 ;; Relinquishing: | |
502 (if (not on-list) | |
503 | |
504 ;; Oops, not registered - leave it be: | |
505 nil | |
506 | |
507 ;; Some registration: | |
508 ; reestablish it: | |
509 (setq prior-capsule (car (cdr on-list))) | |
510 (if prior-capsule | |
511 (set name (car prior-capsule)) ; Some prior value - reestablish it. | |
512 (makunbound name)) ; Previously unbound - demolish var. | |
513 ; Remove registration: | |
514 (let (rebuild) | |
515 (while outline-mode-prior-settings | |
516 (if (not (eq (car outline-mode-prior-settings) | |
517 on-list)) | |
518 (setq rebuild | |
519 (cons (car outline-mode-prior-settings) | |
520 rebuild))) | |
521 (setq outline-mode-prior-settings | |
522 (cdr outline-mode-prior-settings))) | |
523 (setq outline-mode-prior-settings rebuild))))) | |
524 ) | |
525 | |
526 ;;;_ : Overall | |
527 ;;;_ = outline-mode | |
528 (defvar outline-mode () "Allout outline mode minor-mode flag.") | |
529 (make-variable-buffer-local 'outline-mode) | |
530 ;;;_ > outline-mode (&optional toggle) | |
531 (defun outline-mode (&optional toggle) | |
532 " Set minor mode for editing outlines with selective display. | |
533 | |
534 Look below the description of the bindings for explanation of the | |
535 terminology use in outline-mode commands. | |
536 | |
537 (Note - this is not a proper minor mode, because it does affect key | |
538 bindings. It's not too improper, however, because it does resurrect | |
539 any bindings which have not been tampered with since it changed them.) | |
540 | |
541 Exposure Commands Movement Commands | |
542 C-c C-h outline-hide-current-subtree C-c C-n outline-next-visible-heading | |
543 C-c C-i outline-show-current-children C-c C-p outline-previous-visible-heading | |
544 C-c C-s outline-show-current-subtree C-c C-u outline-up-current-level | |
545 C-c C-o outline-show-current-entry C-c C-f outline-forward-current-level | |
546 C-c ! outline-show-all C-c C-b outline-backward-current-level | |
547 outline-hide-current-leaves C-c C-e outline-end-of-current-entry | |
548 C-c C-a outline-beginning-of-current-entry | |
549 | |
550 | |
551 Topic Header Generation Commands | |
552 C-c<SP> open-sibtopic Create a new sibling after current topic | |
553 C-c . open-subtopic ... an offspring of current topic | |
554 C-c , open-supertopic ... a sibling of the current topic's parent | |
555 | |
556 Level and Prefix Adjustment Commands | |
557 C-c > outline-shift-in Shift current topic and all offspring deeper | |
558 C-c < outline-shift-out ... less deep | |
559 C-c<CR> outline-rebullet-topic Reconcile bullets of topic and its offspring | |
560 - distinctive bullets are not changed, all | |
561 others set suitable according to depth | |
562 C-c b outline-rebullet-current-heading Prompt for alternate bullet for | |
563 current topic | |
564 C-c # outline-number-siblings Number bullets of topic and siblings - the | |
565 offspring are not affected. With repeat | |
566 count, revoke numbering. | |
567 | |
568 Killing and Yanking - all keep siblings numbering reconciled as appropriate | |
569 C-k outline-kill-line Regular kill line, but respects numbering ,etc | |
570 C-c C-k outline-kill-topic Kill current topic, including offspring | |
571 C-y outline-yank Yank, adjusting depth of yanked topic to | |
572 depth of heading if yanking into bare topic | |
573 heading (ie, prefix sans text) | |
574 M-y outline-yank-pop Is to outline-yank as yank-pop is to yank | |
575 | |
576 Misc commands | |
577 C-c @ outline-resolve-xref pop-to-buffer named by xref (cf | |
578 outline-file-xref-bullet) | |
579 C-c c outline-copy-exposed Copy outline sans all hidden stuff to | |
580 another buffer whose name is derived | |
581 from the current one - \"XXX exposed\" | |
3549
a4d9c9bc3994
(outlinify-sticky): Renamed from outlineify-sticky.
Richard M. Stallman <rms@gnu.org>
parents:
3430
diff
changeset
|
582 M-x outlinify-sticky Activate outline mode for current buffer |
3430 | 583 and establish -*- outline -*- mode specifier |
584 as well as file local vars to automatically | |
585 set exposure. Try it. | |
586 | |
587 Terminology | |
588 | |
589 Topic: A basic cohesive component of an emacs outline, which can | |
590 be closed (made hidden), opened (revealed), generated, | |
591 traversed, and shifted as units, using outline-mode functions. | |
592 A topic is composed of a HEADER, a BODY, and SUBTOPICs (see below). | |
593 | |
594 Exposure: Hidden (~closed~) topics are represented by ellipses ('...') | |
595 at the end of the visible SUPERTOPIC which contains them, | |
596 rather than by their actual text. Hidden topics are still | |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
3549
diff
changeset
|
597 susceptible to editing and regular movement functions, they |
3430 | 598 just are not displayed normally, effectively collapsed into |
599 the ellipses which represent them. Outline mode provides | |
600 the means to selectively expose topics based on their | |
601 NESTING. | |
602 | |
603 SUBTOPICS of a topic can be hidden and subsequently revealed | |
604 based on their DEPTH relative to the supertopic from which | |
605 the exposure is being done. | |
606 | |
607 The BODIES of a topic do not generally become visible except | |
608 during exposure of entire subtrees (see documentation for | |
609 '-current-subtree'), or when the entry is explicitly exposed | |
610 with the 'outline-show-entry' function, or (if you have a | |
611 special version of isearch installed) when encountered by | |
612 incremental searches. | |
613 | |
614 The CURRENT topic is the more recent visible one before or | |
615 including the text cursor. | |
616 | |
617 Header: The initial portion of an outline topic. It is composed of a | |
618 topic header PREFIX at the beginning of the line, followed by | |
619 text to the end of the EFFECTIVE LINE. | |
620 | |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
3549
diff
changeset
|
621 Body: Any subsequent lines of text following a topic header and preceding |
3430 | 622 the next one. This is also referred to as the entry for a topic. |
623 | |
624 Prefix: The text which distinguishes topic headers from normal text | |
625 lines. There are two forms, both of which start at the beginning | |
626 of the topic header (EFFECTIVE) line. The length of the prefix | |
627 represents the DEPTH of the topic. The fundamental sort begins | |
628 either with solely an asterisk ('*') or else dot ('.') followed | |
629 by zero or more spaces and then an outline BULLET. [Note - you | |
630 can now designate your own, arbitrary HEADER-LEAD string, by | |
631 setting the variable 'outline-header-prefix'.] The second form | |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
3549
diff
changeset
|
632 is for backwards compatibility with the original emacs outline |
3430 | 633 mode, and consists solely of asterisks. Both sorts are |
634 recognized by all outline commands. The first sort is generated | |
635 by outline topic production commands if the emacs variable | |
636 outline-old-style-prefixes is nil, otherwise the second style is | |
637 used. | |
638 | |
639 Bullet: An outline prefix bullet is one of the characters on either | |
640 of the outline bullet string vars, 'outline-plain-bullets-string' | |
641 and 'outline-distinctive-bullets-string'. (See their | |
642 documentation for more details.) The default choice of bullet | |
643 for any prefix depends on the DEPTH of the topic. | |
644 | |
645 Depth and Nesting: | |
646 The length of a topic header prefix, from the initial | |
647 character to the bullet (inclusive), represents the depth of | |
648 the topic. A topic is considered to contain the subsequent | |
649 topics of greater depth up to the next topic of the same | |
650 depth, and the contained topics are recursively considered to | |
651 be nested within all containing topics. Contained topics are | |
652 called subtopics. Immediate subtopics are called 'children'. | |
653 Containing topics are supertopicsimmediate supertopics are | |
654 'parents'. Contained topics of the same depth are called | |
655 siblings. | |
656 | |
657 Effective line: The regular ascii text in which form outlines are | |
658 saved are manipulated in outline-mode to engage emacs' | |
659 selective-display faculty. The upshot is that the | |
660 effective end of an outline line can be terminated by | |
661 either a normal Unix newline char, \n, or the special | |
662 outline-mode eol, ^M. This only matters at the user | |
663 level when you're doing searches which key on the end of | |
664 line character." | |
665 | |
666 (interactive "P") | |
667 | |
668 (let* ((active (and (boundp 'outline-mode) outline-mode)) | |
669 (toggle (and toggle | |
670 (or (and (listp toggle)(car toggle)) | |
671 toggle))) | |
672 (explicit-activation (and toggle | |
673 (or (symbolp toggle) | |
674 (and (natnump toggle) | |
675 (not (zerop toggle))))))) | |
676 | |
677 (cond | |
678 | |
679 ((and (not explicit-activation) (or active toggle)) | |
680 ;; Activation not explicitly requested, and either in active | |
681 ;; state or deactivation specifically requested: | |
682 (outline-minor-relinquish-keys) | |
683 (outline-resumptions 'selective-display) | |
684 (outline-resumptions 'indent-tabs-mode) | |
685 (outline-resumptions 'paragraph-start) | |
686 (outline-resumptions 'paragraph-separate) | |
687 (setq outline-mode nil)) | |
688 | |
689 ;; Deactivation *not* indicated. | |
690 ((not active) | |
691 ;; Not already active - activate: | |
692 (outline-minor-bind-keys) | |
693 (outline-resumptions 'selective-display '(t)) | |
694 (outline-resumptions 'indent-tabs-mode '(nil)) | |
695 (or (assq 'outline-mode minor-mode-alist) | |
696 (setq minor-mode-alist | |
697 (cons '(outline-mode " Outline") minor-mode-alist))) | |
698 (set-outline-regexp) | |
699 | |
700 (make-local-variable 'paragraph-start) | |
701 (outline-resumptions 'paragraph-start | |
702 (list (concat paragraph-start "\\|^\\(" | |
703 outline-regexp "\\)"))) | |
704 (make-local-variable 'paragraph-separate) | |
705 (outline-resumptions 'paragraph-separate | |
706 (list (concat paragraph-separate "\\|^\\(" | |
707 outline-regexp "\\)"))) | |
708 | |
709 (if outline-enwrap-isearch-mode | |
710 (outline-enwrap-isearch)) | |
711 (if (and outline-use-hanging-indents | |
712 (boundp 'filladapt-prefix-table)) | |
713 ;; Add outline-prefix recognition to filladapt - not standard: | |
714 (progn (setq filladapt-prefix-table | |
715 (cons (cons (concat "\\(" outline-regexp "\\) ") | |
716 'filladapt-hanging-list) | |
717 filladapt-prefix-table)) | |
718 (setq filladapt-hanging-list-prefixes | |
719 (cons outline-regexp | |
720 filladapt-hanging-list-prefixes)))) | |
721 (run-hooks 'outline-mode-hook) | |
722 (setq outline-mode t)) | |
723 ) ; cond | |
724 ) ; let* | |
725 ) ; defun | |
726 | |
727 | |
728 ;;;_ #2 Internal Position State-Tracking Variables | |
729 ;;; All basic outline functions which directly do string matches to | |
730 ;;; evaluate heading prefix location set the variables | |
731 ;;; outline-recent-prefix-beginning and outline-recent-prefix-end when | |
732 ;;; successful. Functions starting with 'outline-recent-' all use | |
733 ;;; this state, providing the means to avoid redundant searches for | |
734 ;;; just established data. This optimization can provide significant | |
735 ;;; speed improvement, but it must be employed carefully. | |
736 ;;;_ = outline-recent-prefix-beginning | |
737 (defvar outline-recent-prefix-beginning 0 | |
738 " Buffer point of the start of the last topic prefix encountered.") | |
739 (make-variable-buffer-local 'outline-recent-prefix-beginning) | |
740 ;;;_ = outline-recent-prefix-end | |
741 (defvar outline-recent-prefix-end 0 | |
742 " Buffer point of the end of the last topic prefix encountered.") | |
743 (make-variable-buffer-local 'outline-recent-prefix-end) | |
744 | |
745 ;;;_ #3 Exposure Control | |
746 | |
747 ;;;_ : Fundamental | |
748 ;;;_ > outline-flag-region (from to flag) | |
749 (defun outline-flag-region (from to flag) | |
750 " Hides or shows lines from FROM to TO, according to FLAG. | |
751 Uses emacs selective-display, where text is show if FLAG put at | |
752 beginning of line is `\\n' (newline character), while text is | |
753 hidden if FLAG is `\\^M' (control-M). | |
754 | |
755 returns nil iff no changes were effected." | |
756 (let ((buffer-read-only nil)) | |
757 (subst-char-in-region from to | |
758 (if (= flag ?\n) ?\^M ?\n) | |
759 flag t))) | |
760 ;;;_ > outline-flag-current-subtree (flag) | |
761 (defun outline-flag-current-subtree (flag) | |
762 (save-excursion | |
763 (outline-back-to-current-heading) | |
764 (outline-flag-region (point) | |
765 (progn (outline-end-of-current-subtree) (point)) | |
766 flag))) | |
767 | |
768 ;;;_ : Topic-specific | |
769 ;;;_ > outline-hide-current-entry () | |
770 (defun outline-hide-current-entry () | |
771 "Hide the body directly following this heading." | |
772 (interactive) | |
773 (outline-back-to-current-heading) | |
774 (save-excursion | |
775 (outline-flag-region (point) | |
776 (progn (outline-end-of-current-entry) (point)) | |
777 ?\^M))) | |
778 ;;;_ > outline-show-current-entry (&optional arg) | |
779 (defun outline-show-current-entry (&optional arg) | |
780 "Show body directly following this heading, or hide it if repeat count." | |
781 (interactive "P") | |
782 (if arg | |
783 (outline-hide-current-entry) | |
784 (save-excursion | |
785 (outline-flag-region (point) | |
786 (progn (outline-end-of-current-entry) (point)) | |
787 ?\n)))) | |
788 ;;;_ > outline-show-entry () | |
789 ; outline-show-entry basically for isearch dynamic exposure, as is... | |
790 (defun outline-show-entry () | |
791 " Like outline-show-current-entry, but reveals an entry that is nested | |
792 within hidden topics." | |
793 (interactive) | |
794 (save-excursion | |
795 (outline-goto-prefix) | |
796 (outline-flag-region (if (not (bobp)) (1- (point)) (point)) | |
797 (progn (outline-pre-next-preface) (point)) ?\n))) | |
798 ;;;_ > outline-hide-current-entry-completely () | |
799 ; ... outline-hide-current-entry-completely also for isearch dynamic exposure: | |
800 (defun outline-hide-current-entry-completely () | |
801 "Like outline-hide-current-entry, but conceal topic completely." | |
802 (interactive) | |
803 (save-excursion | |
804 (outline-goto-prefix) | |
805 (outline-flag-region (if (not (bobp)) (1- (point)) (point)) | |
806 (progn (outline-pre-next-preface) | |
807 (if (looking-at "\C-m") | |
808 (point) | |
809 (1- (point)))) | |
810 ?\C-m))) | |
811 ;;;_ > outline-show-current-subtree () | |
812 (defun outline-show-current-subtree () | |
813 "Show everything after this heading at deeper levels." | |
814 (interactive) | |
815 (outline-flag-current-subtree ?\n)) | |
816 ;;;_ > outline-hide-current-subtree (&optional just-close) | |
817 (defun outline-hide-current-subtree (&optional just-close) | |
818 | |
819 " Hide everything after this heading at deeper levels, or if it's | |
820 already closed, and optional arg JUST-CLOSE is nil, hide the current | |
821 level." | |
822 | |
823 (interactive) | |
824 (let ((orig-eol (save-excursion | |
825 (end-of-line)(outline-goto-prefix)(end-of-line)(point)))) | |
826 (outline-flag-current-subtree ?\^M) | |
827 (if (and (= orig-eol (save-excursion (goto-char orig-eol) | |
828 (end-of-line) | |
829 (point))) | |
830 ;; Structure didn't change - try hiding current level: | |
831 (if (not just-close) | |
832 (outline-up-current-level 1 t))) | |
833 (outline-hide-current-subtree)))) | |
834 ;;;_ > outline-show-current-branches () | |
835 (defun outline-show-current-branches () | |
836 "Show all subheadings of this heading, but not their bodies." | |
837 (interactive) | |
838 (outline-show-current-children 1000)) | |
839 ;;;_ > outline-hide-current-leaves () | |
840 (defun outline-hide-current-leaves () | |
841 "Hide all body after this heading at deeper levels." | |
842 (interactive) | |
843 (outline-back-to-current-heading) | |
844 (outline-hide-region-body (point) (progn (outline-end-of-current-subtree) | |
845 (point)))) | |
846 ;;;_ > outline-show-current-children (&optional level) | |
847 (defun outline-show-current-children (&optional level) | |
848 " Show all direct subheadings of this heading. Optional LEVEL specifies | |
849 how many levels below the current level should be shown." | |
850 (interactive "p") | |
851 (or level (setq level 1)) | |
852 (save-excursion | |
853 (save-restriction | |
854 (beginning-of-line) | |
855 (setq level (+ level (progn (outline-back-to-current-heading) | |
856 (outline-recent-depth)))) | |
857 (narrow-to-region (point) | |
858 (progn (outline-end-of-current-subtree) (1+ (point)))) | |
859 (goto-char (point-min)) | |
860 (while (and (not (eobp)) | |
861 (outline-next-heading)) | |
862 (if (<= (outline-recent-depth) level) | |
863 (save-excursion | |
864 (let ((end (1+ (point)))) | |
865 (forward-char -1) | |
866 (if (memq (preceding-char) '(?\n ?\^M)) | |
867 (forward-char -1)) | |
868 (outline-flag-region (point) end ?\n)))))))) | |
869 | |
870 ;;;_ : Region and beyond | |
871 ;;;_ > outline-show-all () | |
872 (defun outline-show-all () | |
873 "Show all of the text in the buffer." | |
874 (interactive) | |
875 (outline-flag-region (point-min) (point-max) ?\n)) | |
876 ;;;_ > outline-hide-bodies () | |
877 (defun outline-hide-bodies () | |
878 "Hide all of buffer except headings." | |
879 (interactive) | |
880 (outline-hide-region-body (point-min) (point-max))) | |
881 ;;;_ > outline-hide-region-body (start end) | |
882 (defun outline-hide-region-body (start end) | |
883 "Hide all body lines in the region, but not headings." | |
884 (save-excursion | |
885 (save-restriction | |
886 (narrow-to-region start end) | |
887 (goto-char (point-min)) | |
888 (while (not (eobp)) | |
889 (outline-flag-region (point) | |
890 (progn (outline-pre-next-preface) (point)) ?\^M) | |
891 (if (not (eobp)) | |
892 (forward-char | |
893 (if (looking-at "[\n\^M][\n\^M]") | |
894 2 1))))))) | |
895 ;;;_ > outline-expose () | |
896 (defun outline-expose (spec &rest followers) | |
897 | |
898 "Dictate wholesale exposure scheme for current topic, according to SPEC. | |
899 | |
900 SPEC is either a number or a list of specs. Optional successive args | |
901 dictate exposure for subsequent siblings of current topic. | |
902 | |
903 Numbers, the symbols '*' and '+', and the null list dictate different | |
904 exposure depths for the corresponding topic. Numbers indicate the | |
905 depth to open, with negative numbers first forcing a close, and then | |
906 opening to their absolute value. Positive numbers jsut reopen, and 0 | |
907 just closes. '*' completely opens the topic, including bodies, and | |
908 '+' shows all the sub headers, but not the bodies. | |
909 | |
910 If the spec is a list, the first element must be a number which | |
911 dictates the exposure depth of the topic as a whole. Subsequent | |
912 elements of the list are nested SPECs, dictating the specific exposure | |
913 for the corresponding offspring of the topic, as the SPEC as a whole | |
914 does for the parent topic. | |
915 | |
916 Optional FOLLOWER elements dictate exposure for subsequent siblings | |
917 of the parent topic." | |
918 | |
919 (interactive "xExposure spec: ") | |
920 (save-excursion | |
921 (let ((start-point (progn (outline-goto-prefix)(point))) | |
922 done) | |
923 (cond ((null spec) nil) | |
924 ((symbolp spec) | |
925 (if (eq spec '*) (outline-show-current-subtree)) | |
926 (if (eq spec '+) (outline-show-current-branches))) | |
927 ((numberp spec) | |
928 (if (zerop spec) | |
929 ;; Just hide if zero: | |
930 (outline-hide-current-subtree t) | |
931 (if (> 0 spec) | |
932 ;; Close before opening if negative: | |
933 (progn (outline-hide-current-subtree) | |
934 (setq spec (* -1 spec)))) | |
935 (outline-show-current-children spec))) | |
936 ((listp spec) | |
937 (outline-expose (car spec)) | |
938 (if (and (outline-descend-to-depth (+ (outline-current-depth) 1)) | |
939 (not (outline-hidden-p))) | |
940 (while (and (setq spec (cdr spec)) | |
941 (not done)) | |
942 (outline-expose (car spec)) | |
943 (setq done (not (outline-next-sibling))))))))) | |
944 (while (and followers (outline-next-sibling)) | |
945 (outline-expose (car followers)) | |
946 (setq followers (cdr followers))) | |
947 ) | |
948 ;;;_ > outline-exposure '() | |
949 (defmacro outline-exposure (&rest spec) | |
950 " Literal frontend for 'outline-expose', passes arguments unevaluated, | |
951 so you needn't quote them." | |
952 (cons 'outline-expose (mapcar '(lambda (x) (list 'quote x)) spec))) | |
953 | |
954 ;;;_ #4 Navigation | |
955 | |
956 ;;;_ : Position Assessment | |
957 | |
958 ;;;_ . Residual state - from most recent outline context operation. | |
959 ;;;_ > outline-recent-depth () | |
960 (defun outline-recent-depth () | |
961 " Return depth of last heading encountered by an outline maneuvering | |
962 function. | |
963 | |
964 All outline functions which directly do string matches to assess | |
965 headings set the variables outline-recent-prefix-beginning and | |
966 outline-recent-prefix-end if successful. This function uses those settings | |
967 to return the current depth." | |
968 | |
969 (max 1 | |
970 (- outline-recent-prefix-end | |
971 outline-recent-prefix-beginning | |
972 outline-header-subtraction))) | |
973 ;;;_ > outline-recent-prefix () | |
974 (defun outline-recent-prefix () | |
975 " Like outline-recent-depth, but returns text of last encountered prefix. | |
976 | |
977 All outline functions which directly do string matches to assess | |
978 headings set the variables outline-recent-prefix-beginning and | |
979 outline-recent-prefix-end if successful. This function uses those settings | |
980 to return the current depth." | |
981 (buffer-substring outline-recent-prefix-beginning outline-recent-prefix-end)) | |
982 ;;;_ > outline-recent-bullet () | |
983 (defun outline-recent-bullet () | |
984 " Like outline-recent-prefix, but returns bullet of last encountered | |
985 prefix. | |
986 | |
987 All outline functions which directly do string matches to assess | |
988 headings set the variables outline-recent-prefix-beginning and | |
989 outline-recent-prefix-end if successful. This function uses those settings | |
990 to return the current depth of the most recently matched topic." | |
991 (buffer-substring (1- outline-recent-prefix-end) outline-recent-prefix-end)) | |
992 | |
993 ;;;_ . Active position evaluation - if you can't use the residual state. | |
994 ;;;_ > outline-on-current-heading-p () | |
995 (defun outline-on-current-heading-p () | |
996 " Return prefix beginning point if point is on same line as current | |
997 visible topic's header line." | |
998 (save-excursion | |
999 (beginning-of-line) | |
1000 (and (looking-at outline-regexp) | |
1001 (setq outline-recent-prefix-end (match-end 0) | |
1002 outline-recent-prefix-beginning (match-beginning 0))))) | |
1003 ;;;_ > outline-hidden-p () | |
1004 (defun outline-hidden-p () | |
1005 "True if point is in hidden text." | |
1006 (interactive) | |
1007 (save-excursion | |
1008 (and (re-search-backward "[\C-j\C-m]" (point-min) t) | |
1009 (looking-at "\C-m")))) | |
1010 ;;;_ > outline-current-depth () | |
1011 (defun outline-current-depth () | |
1012 " Return the depth to which the current containing visible topic is | |
1013 nested in the outline." | |
1014 (save-excursion | |
1015 (if (outline-back-to-current-heading) | |
1016 (max 1 | |
1017 (- outline-recent-prefix-end | |
1018 outline-recent-prefix-beginning | |
1019 outline-header-subtraction)) | |
1020 0))) | |
1021 ;;;_ > outline-depth () | |
1022 (defun outline-depth () | |
1023 " Like outline-current-depth, but respects hidden as well as visible | |
1024 topics." | |
1025 (save-excursion | |
1026 (if (outline-goto-prefix) | |
1027 (outline-recent-depth) | |
1028 (progn | |
1029 (setq outline-recent-prefix-end (point) | |
1030 outline-recent-prefix-beginning (point)) | |
1031 0)))) | |
1032 ;;;_ > outline-get-current-prefix () | |
1033 (defun outline-get-current-prefix () | |
1034 " Topic prefix of the current topic." | |
1035 (save-excursion | |
1036 (if (outline-goto-prefix) | |
1037 (outline-recent-prefix)))) | |
1038 ;;;_ > outline-get-bullet () | |
1039 (defun outline-get-bullet () | |
1040 " Return bullet of containing topic (visible or not)." | |
1041 (save-excursion | |
1042 (and (outline-goto-prefix) | |
1043 (outline-recent-bullet)))) | |
1044 ;;;_ > outline-current-bullet () | |
1045 (defun outline-current-bullet () | |
1046 " Return bullet of current (visible) topic heading, or none if none found." | |
1047 (condition-case err | |
1048 (save-excursion | |
1049 (outline-back-to-current-heading) | |
1050 (buffer-substring (- outline-recent-prefix-end 1) | |
1051 outline-recent-prefix-end)) | |
1052 ;; Quick and dirty provision, ostensibly for missing bullet: | |
1053 (args-out-of-range nil)) | |
1054 ) | |
1055 ;;;_ > outline-get-prefix-bullet (prefix) | |
1056 (defun outline-get-prefix-bullet (prefix) | |
1057 " Return the bullet of the header prefix string PREFIX." | |
1058 ;; Doesn't make sense if we're old-style prefixes, but this just | |
1059 ;; oughtn't be called then, so forget about it... | |
1060 (if (string-match outline-regexp prefix) | |
1061 (substring prefix (1- (match-end 0)) (match-end 0)))) | |
1062 | |
1063 ;;;_ : Within Topic | |
1064 ;;;_ > outline-goto-prefix () | |
1065 (defun outline-goto-prefix () | |
1066 " Put point at beginning of outline prefix for current topic, visible | |
1067 or not. | |
1068 | |
1069 Returns a list of char address of the beginning of the prefix and the | |
1070 end of it, or nil if none." | |
1071 | |
1072 (cond ((and (or (save-excursion (beginning-of-line) (bobp)) | |
1073 (memq (preceding-char) '(?\n ?\^M))) | |
1074 (looking-at outline-regexp)) | |
1075 (setq outline-recent-prefix-end (match-end 0) | |
1076 outline-recent-prefix-beginning | |
1077 (goto-char (match-beginning 0)))) | |
1078 ((re-search-backward outline-line-boundary-regexp | |
1079 ;; unbounded search, | |
1080 ;; stay at limit and return nil if failed: | |
1081 nil 1) | |
1082 (setq outline-recent-prefix-end (match-end 2) | |
1083 outline-recent-prefix-beginning | |
1084 (goto-char (match-beginning 2)))) | |
1085 ;; We should be at the beginning of the buffer if the last | |
1086 ;; condition failed. line-boundary-regexp doesn't cover topic | |
1087 ;; at bob - Check for it. | |
1088 ((looking-at outline-regexp) | |
1089 (setq outline-recent-prefix-end (match-end 0) | |
1090 outline-recent-prefix-beginning | |
1091 (goto-char (match-beginning 0))))) | |
1092 ) | |
1093 ;;;_ > outline-end-of-prefix () | |
1094 (defun outline-end-of-prefix () | |
1095 " Position cursor at beginning of header text." | |
1096 (if (not (outline-goto-prefix)) | |
1097 nil | |
1098 (let ((match-data (match-data))) | |
1099 (goto-char (match-end 0)) | |
1100 (while (looking-at "[0-9]") (forward-char 1)) | |
1101 (if (and (not (eolp)) (looking-at "\\s-")) (forward-char 1)) | |
1102 (store-match-data match-data)) | |
1103 ;; Reestablish where we are: | |
1104 (outline-current-depth)) | |
1105 ) | |
1106 ;;;_ > outline-back-to-current-heading () | |
1107 (defun outline-back-to-current-heading () | |
1108 " Move to heading line of current visible topic, or beginning of heading | |
1109 if already on visible heading line." | |
1110 (beginning-of-line) | |
1111 (prog1 (or (outline-on-current-heading-p) | |
1112 (and (re-search-backward (concat "^\\(" outline-regexp "\\)") | |
1113 nil | |
1114 'move) | |
1115 (setq outline-recent-prefix-end (match-end 1) | |
1116 outline-recent-prefix-beginning (match-beginning 1)))) | |
1117 (if (interactive-p) (outline-end-of-prefix)) | |
1118 ) | |
1119 ) | |
1120 ;;;_ > outline-pre-next-preface () | |
1121 (defun outline-pre-next-preface () | |
1122 "Skip forward to just before the next heading line. | |
1123 | |
1124 Returns that character position." | |
1125 | |
1126 (if (re-search-forward outline-line-boundary-regexp nil 'move) | |
1127 (progn (goto-char (match-beginning 0)) | |
1128 (setq outline-recent-prefix-end (match-end 2) | |
1129 outline-recent-prefix-beginning (match-beginning 2)))) | |
1130 ) | |
1131 ;;;_ > outline-end-of-current-subtree () | |
1132 (defun outline-end-of-current-subtree () | |
1133 " Put point at the end of the last leaf in the currently visible topic." | |
1134 (interactive) | |
1135 (outline-back-to-current-heading) | |
1136 (let ((opoint (point)) | |
1137 (level (outline-recent-depth))) | |
1138 (outline-next-heading) | |
1139 (while (and (not (eobp)) | |
1140 (> (outline-recent-depth) level)) | |
1141 (outline-next-heading)) | |
1142 (if (not (eobp)) (forward-char -1)) | |
1143 (if (memq (preceding-char) '(?\n ?\^M)) (forward-char -1)))) | |
1144 ;;;_ > outline-beginning-of-current-entry () | |
1145 (defun outline-beginning-of-current-entry () | |
1146 " Position the point at the beginning of the body of the current topic." | |
1147 (interactive) | |
1148 (outline-end-of-prefix)) | |
1149 ;;;_ > outline-beginning-of-current-entry () | |
1150 (defun outline-end-of-current-entry () | |
1151 " Position the point at the end of the current topic's entry." | |
1152 (interactive) | |
1153 (outline-show-entry) | |
1154 (prog1 (outline-pre-next-preface) | |
1155 (if (and (not (bobp))(looking-at "^$")) | |
1156 (forward-char -1))) | |
1157 ) | |
1158 | |
1159 ;;;_ : Depth-wise | |
1160 ;;;_ > outline-ascend-to-depth (depth) | |
1161 (defun outline-ascend-to-depth (depth) | |
1162 " Ascend to depth DEPTH, returning depth if successful, nil if not." | |
1163 (if (and (> depth 0)(<= depth (outline-depth))) | |
1164 (let ((last-good (point))) | |
1165 (while (and (< depth (outline-depth)) | |
1166 (setq last-good (point)) | |
1167 (outline-beginning-of-level) | |
1168 (outline-previous-heading))) | |
1169 (if (= (outline-recent-depth) depth) | |
1170 (progn (goto-char outline-recent-prefix-beginning) | |
1171 depth) | |
1172 (goto-char last-good) | |
1173 nil)) | |
1174 (if (interactive-p) (outline-end-of-prefix)) | |
1175 ) | |
1176 ) | |
1177 ;;;_ > outline-descend-to-depth (depth) | |
1178 (defun outline-descend-to-depth (depth) | |
1179 " Descend to depth DEPTH within current topic, returning depth if | |
1180 successful, nil if not." | |
1181 (let ((start-point (point)) | |
1182 (start-depth (outline-depth))) | |
1183 (while | |
1184 (and (> (outline-depth) 0) | |
1185 (not (= depth (outline-recent-depth))) ; ... not there yet | |
1186 (outline-next-heading) ; ... go further | |
1187 (< start-depth (outline-recent-depth)))) ; ... still in topic | |
1188 (if (and (> (outline-depth) 0) | |
1189 (= (outline-recent-depth) depth)) | |
1190 depth | |
1191 (goto-char start-point) | |
1192 nil)) | |
1193 ) | |
1194 ;;;_ > outline-up-current-level (arg &optional dont-complain) | |
1195 (defun outline-up-current-level (arg &optional dont-complain) | |
1196 " Move to the heading line of which the present line is a subheading. | |
1197 With argument, move up ARG levels. Don't return an error if | |
1198 second, optional argument DONT-COMPLAIN, is non-nil." | |
1199 (interactive "p") | |
1200 (outline-back-to-current-heading) | |
1201 (let ((present-level (outline-recent-depth))) | |
1202 ;; Loop for iterating arg: | |
1203 (while (and (> (outline-recent-depth) 1) | |
1204 (> arg 0) | |
1205 (not (bobp))) | |
1206 ;; Loop for going back over current or greater depth: | |
1207 (while (and (not (< (outline-recent-depth) present-level)) | |
1208 (outline-previous-visible-heading 1))) | |
1209 (setq present-level (outline-current-depth)) | |
1210 (setq arg (- arg 1))) | |
1211 ) | |
1212 (prog1 (if (<= arg 0) | |
1213 outline-recent-prefix-beginning | |
1214 (if (interactive-p) (outline-end-of-prefix)) | |
1215 (if (not dont-complain) | |
1216 (error "Can't ascend past outermost level."))) | |
1217 (if (interactive-p) (outline-end-of-prefix))) | |
1218 ) | |
1219 | |
1220 ;;;_ : Linear | |
1221 ;;;_ > outline-next-visible-heading (arg) | |
1222 (defun outline-next-visible-heading (arg) | |
1223 " Move to the next visible heading line. | |
1224 | |
1225 With argument, repeats, backward if negative." | |
1226 (interactive "p") | |
1227 (if (< arg 0) (beginning-of-line) (end-of-line)) | |
1228 (if (re-search-forward (concat "^\\(" outline-regexp "\\)") | |
1229 nil | |
1230 'go | |
1231 arg) | |
1232 (progn (outline-end-of-prefix) | |
1233 (setq outline-recent-prefix-end (match-end 1) | |
1234 outline-recent-prefix-beginning (match-beginning 1)))) | |
1235 ) | |
1236 ;;;_ > outline-previous-visible-heading (arg) | |
1237 (defun outline-previous-visible-heading (arg) | |
1238 " Move to the previous heading line. | |
1239 | |
1240 With argument, repeats or can move forward if negative. | |
1241 A heading line is one that starts with a `*' (or that outline-regexp | |
1242 matches)." | |
1243 (interactive "p") | |
1244 (outline-next-visible-heading (- arg)) | |
1245 ) | |
1246 ;;;_ > outline-next-heading (&optional backward) | |
1247 (defun outline-next-heading (&optional backward) | |
1248 " Move to the heading for the topic (possibly invisible) before this one. | |
1249 | |
1250 Optional arg BACKWARD means search for most recent prior heading. | |
1251 | |
1252 Returns the location of the heading, or nil if none found." | |
1253 | |
1254 (if (and backward (bobp)) | |
1255 nil | |
1256 (if backward (outline-goto-prefix) | |
1257 (if (and (bobp) (not (eobp))) | |
1258 (forward-char 1))) | |
1259 | |
1260 (if (if backward | |
1261 ;; searches are unbounded and return nil if failed: | |
1262 (or (re-search-backward outline-line-boundary-regexp | |
1263 nil | |
1264 0) | |
1265 (looking-at outline-bob-regexp)) | |
1266 (re-search-forward outline-line-boundary-regexp | |
1267 nil | |
1268 0)) | |
1269 (progn;; Got some valid location state - set vars: | |
1270 (setq outline-recent-prefix-end | |
1271 (or (match-end 2) outline-recent-prefix-end)) | |
1272 (goto-char (setq outline-recent-prefix-beginning | |
1273 (or (match-beginning 2) | |
1274 outline-recent-prefix-beginning)))) | |
1275 ) | |
1276 ) | |
1277 ) | |
1278 ;;;_ > outline-previous-heading () | |
1279 (defun outline-previous-heading () | |
1280 " Move to the next (possibly invisible) heading line. | |
1281 | |
1282 Optional repeat-count arg means go that number of headings. | |
1283 | |
1284 Return the location of the beginning of the heading, or nil if not found." | |
1285 | |
1286 (outline-next-heading t) | |
1287 ) | |
1288 ;;;_ > outline-next-sibling (&optional backward) | |
1289 (defun outline-next-sibling (&optional backward) | |
1290 " Like outline-forward-current-level, but respects invisible topics. | |
1291 | |
1292 Go backward if optional arg BACKWARD is non-nil. | |
1293 | |
1294 Return depth if successful, nil otherwise." | |
1295 | |
1296 (if (and backward (bobp)) | |
1297 nil | |
1298 (let ((start-depth (outline-depth)) | |
1299 (start-point (point)) | |
1300 last-good) | |
1301 (while (and (not (if backward (bobp) (eobp))) | |
1302 (if backward (outline-previous-heading) | |
1303 (outline-next-heading)) | |
1304 (> (outline-recent-depth) start-depth))) | |
1305 (if (and (not (eobp)) | |
1306 (and (> (outline-depth) 0) | |
1307 (= (outline-recent-depth) start-depth))) | |
1308 outline-recent-prefix-beginning | |
1309 (goto-char start-point) | |
1310 nil) | |
1311 ) | |
1312 ) | |
1313 ) | |
1314 ;;;_ > outline-previous-sibling (&optional arg) | |
1315 (defun outline-previous-sibling (&optional arg) | |
1316 " Like outline-forward-current-level, but goes backwards and respects | |
1317 invisible topics. | |
1318 | |
1319 Optional repeat count means go number backward. | |
1320 | |
1321 Note that the beginning of a level is (currently) defined by this | |
1322 implementation to be the first of previous successor topics of | |
1323 equal or greater depth. | |
1324 | |
1325 Return depth if successful, nil otherwise." | |
1326 (outline-next-sibling t) | |
1327 ) | |
1328 ;;;_ > outline-beginning-of-level () | |
1329 (defun outline-beginning-of-level () | |
1330 " Go back to the first sibling at this level, visible or not." | |
1331 (outline-end-of-level 'backward)) | |
1332 ;;;_ > outline-end-of-level (&optional backward) | |
1333 (defun outline-end-of-level (&optional backward) | |
1334 " Go to the last sibling at this level, visible or not." | |
1335 | |
1336 (while (outline-previous-sibling)) | |
1337 (prog1 (outline-recent-depth) | |
1338 (if (interactive-p) (outline-end-of-prefix))) | |
1339 ) | |
1340 ;;;_ > outline-forward-current-level (arg &optional backward) | |
1341 (defun outline-forward-current-level (arg &optional backward) | |
1342 " Position the point at the next heading of the same level, taking | |
1343 optional repeat-count. | |
1344 | |
1345 Returns that position, else nil if is not found." | |
1346 (interactive "p") | |
1347 (outline-back-to-current-heading) | |
1348 (let ((amt (if arg (if (< arg 0) | |
1349 ;; Negative arg - invert direction. | |
1350 (progn (setq backward (not backward)) | |
1351 (abs arg)) | |
1352 arg);; Positive arg - just use it. | |
1353 1)));; No arg - use 1: | |
1354 (while (and (> amt 0) | |
1355 (outline-next-sibling backward)) | |
1356 (setq amt (1- amt))) | |
1357 (if (interactive-p) (outline-end-of-prefix)) | |
1358 (if (> amt 0) | |
1359 (error "This is the %s topic on level %d." | |
1360 (if backward "first" "last") | |
1361 (outline-current-depth)) | |
1362 t) | |
1363 ) | |
1364 ) | |
1365 ;;;_ > outline-backward-current-level (arg) | |
1366 (defun outline-backward-current-level (arg) | |
1367 " Position the point at the previous heading of the same level, taking | |
1368 optional repeat-count. | |
1369 | |
1370 Returns that position, else nil if is not found." | |
1371 (interactive "p") | |
1372 (unwind-protect | |
1373 (outline-forward-current-level arg t) | |
1374 (outline-end-of-prefix)) | |
1375 ) | |
1376 | |
1377 ;;;_ : Search with Dynamic Exposure (requires isearch-mode) | |
1378 ;;;_ = outline-search-reconceal | |
1379 (defvar outline-search-reconceal nil | |
1380 "Used for outline isearch provisions, to track whether current search | |
1381 match was concealed outside of search. The value is the location of the | |
1382 match, if it was concealed, regular if the entire topic was concealed, in | |
1383 a list if the entry was concealed.") | |
1384 ;;;_ = outline-search-quitting | |
1385 (defconst outline-search-quitting nil | |
1386 "Variable used by isearch-terminate/outline-provisions and | |
1387 isearch-done/outline-provisions to distinguish between a conclusion | |
1388 and cancellation of a search.") | |
1389 | |
1390 ;;;_ > outline-enwrap-isearch () | |
1391 (defun outline-enwrap-isearch () | |
1392 " Impose isearch-mode wrappers so isearch progressively exposes and | |
1393 reconceals hidden topics when working in outline mode, but works | |
1394 elsewhere. | |
1395 | |
1396 The function checks to ensure that the rebindings are done only once." | |
1397 | |
1398 ; Should isearch-mode be employed, | |
1399 (if (or (not outline-enwrap-isearch-mode) | |
1400 ; or are preparations already done? | |
1401 (fboundp 'real-isearch-terminate)) | |
1402 | |
1403 ;; ... no - skip this all: | |
1404 nil | |
1405 | |
1406 ;; ... yes: | |
1407 | |
1408 ; Ensure load of isearch-mode: | |
1409 (if (or (and (fboundp 'isearch-mode) | |
1410 (fboundp 'isearch-quote-char)) | |
1411 (condition-case error | |
1412 (load-library outline-enwrap-isearch-mode) | |
1413 (file-error (message "Skipping isearch-mode provisions - %s '%s'" | |
1414 (car (cdr error)) | |
1415 (car (cdr (cdr error)))) | |
1416 (sit-for 1) | |
1417 ;; Inhibit subsequent tries and return nil: | |
1418 (setq outline-enwrap-isearch-mode nil)))) | |
1419 ;; Isearch-mode loaded, encapsulate specific entry points for | |
1420 ;; outline dynamic-exposure business: | |
1421 (progn | |
1422 | |
1423 ; stash crucial isearch-mode | |
1424 ; funcs under known, private | |
1425 ; names, then register wrapper | |
1426 ; functions under the old | |
1427 ; names, in their stead: | |
1428 ; 'isearch-quit' is pre v 1.2: | |
1429 (fset 'real-isearch-terminate | |
1430 ; 'isearch-quit is pre v 1.2: | |
1431 (or (if (fboundp 'isearch-quit) | |
1432 (symbol-function 'isearch-quit)) | |
1433 (if (fboundp 'isearch-abort) | |
1434 ; 'isearch-abort' is v 1.2 and on: | |
1435 (symbol-function 'isearch-abort)))) | |
1436 (fset 'isearch-quit 'isearch-terminate/outline-provisions) | |
1437 (fset 'isearch-abort 'isearch-terminate/outline-provisions) | |
1438 (fset 'real-isearch-done (symbol-function 'isearch-done)) | |
1439 (fset 'isearch-done 'isearch-done/outline-provisions) | |
1440 (fset 'real-isearch-update (symbol-function 'isearch-update)) | |
1441 (fset 'isearch-update 'isearch-update/outline-provisions) | |
1442 (make-variable-buffer-local 'outline-search-reconceal)) | |
1443 ) | |
1444 ) | |
1445 ) | |
1446 ;;;_ > outline-isearch-arrival-business () | |
1447 (defun outline-isearch-arrival-business () | |
1448 " Do outline business like exposing current point, if necessary, | |
1449 registering reconcealment requirements in outline-search-reconceal | |
1450 accordingly. | |
1451 | |
1452 Set outline-search-reconceal to nil if current point is not | |
1453 concealed, to value of point if entire topic is concealed, and a | |
1454 list containing point if only the topic body is concealed. | |
1455 | |
1456 This will be used to determine whether outline-hide-current-entry | |
1457 or outline-hide-current-entry-completely will be necessary to | |
1458 restore the prior concealment state." | |
1459 | |
1460 (if (and (boundp 'outline-mode) outline-mode) | |
1461 (setq outline-search-reconceal | |
1462 (if (outline-hidden-p) | |
1463 (save-excursion | |
1464 (if (re-search-backward outline-line-boundary-regexp nil 1) | |
1465 ;; Nil value means we got to b-o-b - wouldn't need | |
1466 ;; to advance. | |
1467 (forward-char 1)) | |
1468 ; We'll return point or list | |
1469 ; containing point, depending | |
1470 ; on concealment state of | |
1471 ; topic prefix. | |
1472 (prog1 (if (outline-hidden-p) (point) (list (point))) | |
1473 ; And reveal the current | |
1474 ; search target: | |
1475 (outline-show-entry))))))) | |
1476 ;;;_ > outline-isearch-advancing-business () | |
1477 (defun outline-isearch-advancing-business () | |
1478 " Do outline business like deexposing current point, if necessary, | |
1479 according to reconceal state registration." | |
1480 (if (and (boundp 'outline-mode) outline-mode outline-search-reconceal) | |
1481 (save-excursion | |
1482 (if (listp outline-search-reconceal) | |
1483 ;; Leave the topic visible: | |
1484 (progn (goto-char (car outline-search-reconceal)) | |
1485 (outline-hide-current-entry)) | |
1486 ;; Rehide the entire topic: | |
1487 (goto-char outline-search-reconceal) | |
1488 (outline-hide-current-entry-completely)))) | |
1489 ) | |
1490 ;;;_ > isearch-terminate/outline-provisions () | |
1491 (defun isearch-terminate/outline-provisions () | |
1492 (interactive) | |
1493 (if (and (boundp 'outline-mode) | |
1494 outline-mode | |
1495 outline-enwrap-isearch-mode) | |
1496 (outline-isearch-advancing-business)) | |
1497 (let ((outline-search-quitting t) | |
1498 (outline-search-reconceal nil)) | |
1499 (real-isearch-terminate))) | |
1500 ;;;_ > isearch-done/outline-provisions () | |
1501 (defun isearch-done/outline-provisions (&optional nopush) | |
1502 (interactive) | |
1503 (if (and (boundp 'outline-mode) | |
1504 outline-mode | |
1505 outline-enwrap-isearch-mode) | |
1506 (progn (save-excursion | |
1507 (if (and outline-search-reconceal | |
1508 (not (listp outline-search-reconceal))) | |
1509 ;; The topic was concealed - reveal it, its siblings, | |
1510 ;; and any ancestors that are still concealed: | |
1511 (progn | |
1512 (message "(exposing destination)")(sit-for 0) | |
1513 ;; Ensure target topic's siblings are exposed: | |
1514 (outline-ascend-to-depth (1- (outline-current-depth))) | |
1515 ;; Ensure that the target topic's ancestors are exposed | |
1516 (while (outline-hidden-p) | |
1517 (outline-show-current-children)) | |
1518 (outline-show-current-children) | |
1519 (outline-show-current-entry))) | |
1520 (outline-isearch-arrival-business)) | |
1521 (if (not (and (boundp 'outline-search-quitting) | |
1522 outline-search-quitting)) | |
1523 (outline-show-current-children)))) | |
1524 (if nopush | |
1525 ;; isearch-done in newer version of isearch mode takes arg: | |
1526 (real-isearch-done nopush) | |
1527 (real-isearch-done))) | |
1528 ;;;_ > isearch-update/outline-provisions () | |
1529 (defun isearch-update/outline-provisions () | |
1530 " Wrapper around isearch which exposes and conceals hidden outline | |
1531 portions encountered in the course of searching." | |
1532 (if (not (and (boundp 'outline-mode) | |
1533 outline-mode | |
1534 outline-enwrap-isearch-mode)) | |
1535 ;; Just do the plain business: | |
1536 (real-isearch-update) | |
1537 | |
1538 ;; Ah - provide for outline conditions: | |
1539 (outline-isearch-advancing-business) | |
1540 (real-isearch-update) | |
1541 (cond (isearch-success (outline-isearch-arrival-business)) | |
1542 ((not isearch-success) (outline-isearch-advancing-business))) | |
1543 ) | |
1544 ) | |
1545 | |
1546 ;;;_ #5 Manipulation | |
1547 | |
1548 ;;;_ : Topic Format Assessment | |
1549 ;;;_ > outline-solicit-alternate-bullet (depth &optional current-bullet) | |
1550 (defun outline-solicit-alternate-bullet (depth &optional current-bullet) | |
1551 | |
1552 " Prompt for and return a bullet char as an alternative to the | |
1553 current one, but offer one suitable for current depth DEPTH | |
1554 as default." | |
1555 | |
1556 (let* ((default-bullet (or current-bullet | |
1557 (outline-bullet-for-depth depth))) | |
1558 (choice (solicit-char-in-string | |
1559 (format "Select bullet: %s ('%s' default): " | |
1560 outline-bullets-string | |
1561 default-bullet) | |
1562 (string-sans-char outline-bullets-string ?\\) | |
1563 t))) | |
1564 (if (string= choice "") default-bullet choice)) | |
1565 ) | |
1566 ;;;_ > outline-sibling-index (&optional depth) | |
1567 (defun outline-sibling-index (&optional depth) | |
1568 " Item number of this prospective topic among it's siblings. | |
1569 | |
1570 If optional arg depth is greater than current depth, then we're | |
1571 opening a new level, and return 0. | |
1572 | |
1573 If less than this depth, ascend to that depth and count..." | |
1574 | |
1575 (save-excursion | |
1576 (cond ((and depth (<= depth 0) 0)) | |
1577 ((or (not depth) (= depth (outline-depth))) | |
1578 (let ((index 1)) | |
1579 (while (outline-previous-sibling) (setq index (1+ index))) | |
1580 index)) | |
1581 ((< depth (outline-recent-depth)) | |
1582 (outline-ascend-to-depth depth) | |
1583 (outline-sibling-index)) | |
1584 (0)))) | |
1585 ;;;_ > outline-distinctive-bullet (bullet) | |
1586 (defun outline-distinctive-bullet (bullet) | |
1587 " True if bullet is one of those on outline-distinctive-bullets-string." | |
1588 (string-match (regexp-quote bullet) outline-distinctive-bullets-string)) | |
1589 ;;;_ > outline-numbered-type-prefix (&optional prefix) | |
1590 (defun outline-numbered-type-prefix (&optional prefix) | |
1591 " True if current header prefix bullet is numbered bullet." | |
1592 (and outline-numbered-bullet | |
1593 (string= outline-numbered-bullet | |
1594 (if prefix | |
1595 (outline-get-prefix-bullet prefix) | |
1596 (outline-get-bullet))))) | |
1597 ;;;_ > outline-bullet-for-depth (&optional depth) | |
1598 (defun outline-bullet-for-depth (&optional depth) | |
1599 " Return outline topic bullet suited to DEPTH, or for current depth if none | |
1600 specified." | |
1601 ;; Find bullet in plain-bullets-string modulo DEPTH. | |
1602 (if outline-stylish-prefixes | |
1603 (char-to-string (aref outline-plain-bullets-string | |
1604 (% (max 0 (- depth 2)) | |
1605 outline-plain-bullets-string-len))) | |
1606 outline-primary-bullet) | |
1607 ) | |
1608 | |
1609 ;;;_ : Topic Production | |
1610 ;;;_ > outline-make-topic-prefix (&optional prior-bullet | |
1611 (defun outline-make-topic-prefix (&optional prior-bullet | |
1612 new | |
1613 depth | |
1614 solicit | |
1615 number-control | |
1616 index) | |
1617 ;; Depth null means use current depth, non-null means we're either | |
1618 ;; opening a new topic after current topic, lower or higher, or we're | |
1619 ;; changing level of current topic. | |
1620 ;; Solicit dominates specified bullet-char. | |
1621 " Generate a topic prefix suitable for optional arg DEPTH, or current | |
1622 depth if not specified. | |
1623 | |
1624 All the arguments are optional. | |
1625 | |
1626 PRIOR-BULLET indicates the bullet of the prefix being changed, or | |
1627 nil if none. This bullet may be preserved (other options | |
1628 notwithstanding) if it is on the outline-distinctive-bullets-string, | |
1629 for instance. | |
1630 | |
1631 Second arg NEW indicates that a new topic is being opened after the | |
1632 topic at point, if non-nil. Default bullet for new topics, eg, may | |
1633 be set (contingent to other args) to numbered bullets if previous | |
1634 sibling is one. The implication otherwise is that the current topic | |
1635 is being adjusted - shifted or rebulleted - and we don't consider | |
1636 bullet or previous sibling. | |
1637 | |
1638 Third arg DEPTH forces the topic prefix to that depth, regardless of | |
1639 the current topics' depth. | |
1640 | |
1641 Fourth arg SOLICIT non-nil provokes solicitation from the user of a | |
1642 choice among the valid bullets. (This overrides other all the | |
1643 options, including, eg, a distinctive PRIOR-BULLET.) | |
1644 | |
1645 Fifth arg, NUMBER-CONTROL, matters only if 'outline-numbered-bullet' | |
1646 is non-nil *and* soliciting was not explicitly invoked. Then | |
1647 NUMBER-CONTROL non-nil forces prefix to either numbered or | |
1648 denumbered format, depending on the value of the sixth arg, INDEX. | |
1649 | |
1650 (Note that NUMBER-CONTROL does *not* apply to level 1 topics. Sorry...) | |
1651 | |
1652 If NUMBER-CONTROL is non-nil and sixth arg INDEX is non-nil then | |
1653 the prefix of the topic is forced to be numbered. Non-nil | |
1654 NUMBER-CONTROL and nil INDEX forces non-numbered format on the | |
1655 bullet. Non-nil NUMBER-CONTROL and non-nil, non-number INDEX means | |
1656 that the index for the numbered prefix will be derived, by counting | |
1657 siblings back to start of level. If INDEX is a number, then that | |
1658 number is used as the index for the numbered prefix (allowing, eg, | |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
3549
diff
changeset
|
1659 sequential renumbering to not require this function counting back the |
3430 | 1660 index for each successive sibling)." |
1661 | |
1662 ;; The options are ordered in likely frequence of use, most common | |
1663 ;; highest, least lowest. Ie, more likely to be doing prefix | |
1664 ;; adjustments than soliciting, and yet more than numbering. | |
1665 ;; Current prefix is least dominant, but most likely to be commonly | |
1666 ;; specified... | |
1667 | |
1668 (let* (body | |
1669 numbering | |
1670 denumbering | |
1671 (depth (or depth (outline-depth))) | |
1672 (header-lead outline-header-prefix) | |
1673 (bullet-char | |
1674 | |
1675 ;; Getting value for bullet char is practically the whole job: | |
1676 | |
1677 (cond | |
1678 ; Simplest situation - level 1: | |
1679 ((<= depth 1) (setq header-lead "") outline-primary-bullet) | |
1680 ; Simple, too: all asterisks: | |
1681 (outline-old-style-prefixes | |
1682 ;; Cheat - make body the whole thing, null out header-lead and | |
1683 ;; bullet-char: | |
1684 (setq body (make-string depth | |
1685 (string-to-char outline-primary-bullet))) | |
1686 (setq header-lead "") | |
1687 "") | |
1688 | |
1689 ;; (Neither level 1 nor old-style, so we're space padding. | |
1690 ;; Sneak it in the condition of the next case, whatever it is.) | |
1691 | |
1692 ;; Solicitation overrides numbering and other cases: | |
1693 ((progn (setq body (make-string (- depth 2) ?\ )) | |
1694 ;; The actual condition: | |
1695 solicit) | |
1696 (let* ((got (outline-solicit-alternate-bullet depth))) | |
1697 ;; Gotta check whether we're numbering and got a numbered bullet: | |
1698 (setq numbering (and outline-numbered-bullet | |
1699 (not (and number-control (not index))) | |
1700 (string= got outline-numbered-bullet))) | |
1701 ;; Now return what we got, regardless: | |
1702 got)) | |
1703 | |
1704 ;; Numbering invoked through args: | |
1705 ((and outline-numbered-bullet number-control) | |
1706 (if (setq numbering (not (setq denumbering (not index)))) | |
1707 outline-numbered-bullet | |
1708 (if (and current-bullet | |
1709 (not (string= outline-numbered-bullet | |
1710 current-bullet))) | |
1711 current-bullet | |
1712 (outline-bullet-for-depth depth)))) | |
1713 | |
1714 ;;; Neither soliciting nor controlled numbering ;;; | |
1715 ;;; (may be controlled denumbering, tho) ;;; | |
1716 | |
1717 ;; Check wrt previous sibling: | |
1718 ((and new ; only check for new prefixes | |
1719 (<= depth (outline-depth)) | |
1720 outline-numbered-bullet ; ... & numbering enabled | |
1721 (not denumbering) | |
1722 (let ((sibling-bullet | |
1723 (save-excursion | |
1724 ;; Locate correct sibling: | |
1725 (or (>= depth (outline-depth)) | |
1726 (outline-ascend-to-depth depth)) | |
1727 (outline-get-bullet)))) | |
1728 (if (and sibling-bullet | |
1729 (string= outline-numbered-bullet sibling-bullet)) | |
1730 (setq numbering sibling-bullet))))) | |
1731 | |
1732 ;; Distinctive prior bullet? | |
1733 ((and prior-bullet | |
1734 (outline-distinctive-bullet prior-bullet) | |
1735 ;; Either non-numbered: | |
1736 (or (not (and outline-numbered-bullet | |
1737 (string= prior-bullet outline-numbered-bullet))) | |
1738 ;; or numbered, and not denumbering: | |
1739 (setq numbering (not denumbering))) | |
1740 ;; Here 'tis: | |
1741 prior-bullet)) | |
1742 | |
1743 ;; Else, standard bullet per depth: | |
1744 ((outline-bullet-for-depth depth))))) | |
1745 | |
1746 (concat header-lead | |
1747 body | |
1748 bullet-char | |
1749 (if numbering | |
1750 (format "%d" (cond ((and index (numberp index)) index) | |
1751 (new (1+ (outline-sibling-index depth))) | |
1752 ((outline-sibling-index)))))) | |
1753 ) | |
1754 ) | |
1755 ;;;_ > open-topic (relative-depth &optional before) | |
1756 (defun open-topic (relative-depth &optional before) | |
1757 " Open a new topic at depth DEPTH. New topic is situated after current | |
1758 one, unless optional flag BEFORE is non-nil, or unless current line | |
1759 is complete empty (not even whitespace), in which case open is done | |
1760 on current line. | |
1761 | |
1762 Nuances: | |
1763 | |
1764 - Creation of new topics is with respect to the visible topic | |
1765 containing the cursor, regardless of intervening concealed ones. | |
1766 | |
1767 - New headers are generally created after/before the body of a | |
1768 topic. However, they are created right at cursor location if the | |
1769 cursor is on a blank line, even if that breaks the current topic | |
1770 body. This is intentional, to provide a simple means for | |
1771 deliberately dividing topic bodies. | |
1772 | |
1773 - Double spacing of topic lists is preserved. Also, the first | |
1774 level two topic is created double-spaced (and so would be | |
1775 subsequent siblings, if that's left intact). Otherwise, | |
1776 single-spacing is used. | |
1777 | |
1778 - Creation of sibling or nested topics is with respect to the topic | |
1779 you're starting from, even when creating backwards. This way you | |
1780 can easily create a sibling in front of the current topic without | |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
3549
diff
changeset
|
1781 having to go to its preceding sibling, and then open forward |
3430 | 1782 from there." |
1783 | |
1784 (let* ((depth (+ (outline-current-depth) relative-depth)) | |
1785 (opening-on-blank (if (looking-at "^\$") | |
1786 (not (setq before nil)))) | |
1787 opening-numbered ; Will get while computing ref-topic, below | |
1788 ref-depth ; Will get while computing ref-topic, next | |
1789 (ref-topic (save-excursion | |
1790 (cond ((< relative-depth 0) | |
1791 (outline-ascend-to-depth depth)) | |
1792 ((>= relative-depth 1) nil) | |
1793 (t (outline-back-to-current-heading))) | |
1794 (setq ref-depth (outline-recent-depth)) | |
1795 (setq opening-numbered | |
1796 (save-excursion | |
1797 (and outline-numbered-bullet | |
1798 (or (<= relative-depth 0) | |
1799 (outline-descend-to-depth depth)) | |
1800 (if (outline-numbered-type-prefix) | |
1801 outline-numbered-bullet)))) | |
1802 (point))) | |
1803 dbl-space | |
1804 doing-beginning | |
1805 ) | |
1806 | |
1807 (if (not opening-on-blank) | |
1808 ; Positioning and vertical | |
1809 ; padding - only if not | |
1810 ; opening-on-blank: | |
1811 (progn | |
1812 (goto-char ref-topic) | |
1813 (setq dbl-space ; Determine double space action: | |
1814 (or (and (not (> relative-depth 0)) | |
1815 ;; not descending, | |
1816 (save-excursion | |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
3549
diff
changeset
|
1817 ;; preceded by a blank line? |
3430 | 1818 (forward-line -1) |
1819 (looking-at "^\\s-*$"))) | |
1820 (and (= ref-depth 1) | |
1821 (or before | |
1822 (= depth 1) | |
1823 (save-excursion | |
1824 ;; Don't already have following | |
1825 ;; vertical padding: | |
1826 (not (outline-pre-next-preface))))))) | |
1827 | |
1828 ; Position to prior heading, | |
1829 ; if inserting backwards: | |
1830 (if before (progn (outline-back-to-current-heading) | |
1831 (setq doing-beginning (bobp)) | |
1832 (if (and (not (outline-previous-sibling)) | |
1833 (not (bobp))) | |
1834 (outline-previous-heading)))) | |
1835 | |
1836 (if (and (<= depth ref-depth) | |
1837 (= ref-depth (outline-current-depth))) | |
1838 ;; Not going inwards, don't snug up: | |
1839 (if doing-beginning | |
1840 (open-line (if dbl-space 2 1)) | |
1841 (outline-end-of-current-subtree)) | |
1842 ;; Going inwards - double-space if first offspring is, | |
1843 ;; otherwise snug up. | |
1844 (end-of-line) ; So we skip any concealed progeny. | |
1845 (outline-pre-next-preface) | |
1846 (if (bolp) | |
1847 ;; Blank lines between current header body and next | |
1848 ;; header - get to last substantive (non-white-space) | |
1849 ;; line in body: | |
1850 (re-search-backward "[^ \t\n]" nil t)) | |
1851 (if (save-excursion | |
1852 (outline-next-heading) | |
1853 (if (> (outline-recent-depth) ref-depth) | |
1854 ;; This is an offspring. | |
1855 (progn (forward-line -1) | |
1856 (looking-at "^\\s-*$")))) | |
1857 (progn (forward-line 1) | |
1858 (open-line 1))) | |
1859 (end-of-line)) | |
1860 ;;(if doing-beginning (goto-char doing-beginning)) | |
1861 (if (not (bobp)) (newline (if dbl-space 2 1))) | |
1862 )) | |
1863 (insert-string (concat (outline-make-topic-prefix opening-numbered | |
1864 t | |
1865 depth) | |
1866 " ")) | |
1867 | |
1868 ;;(if doing-beginning (save-excursion (newline (if dbl-space 2 1)))) | |
1869 | |
1870 | |
1871 (outline-rebullet-heading nil ;;; solicit | |
1872 depth ;;; depth | |
1873 nil ;;; number-control | |
1874 nil ;;; index | |
1875 t) (end-of-line) | |
1876 ) | |
1877 ) | |
1878 ;;;_ > open-subtopic (arg) | |
1879 (defun open-subtopic (arg) | |
1880 " Open new topic header at deeper level than the current one. | |
1881 | |
1882 Negative universal arg means to open deeper, but place the new topic | |
1883 prior to the current one." | |
1884 (interactive "p") | |
1885 (open-topic 1 (> 0 arg))) | |
1886 ;;;_ > open-sibtopic (arg) | |
1887 (defun open-sibtopic (arg) | |
1888 " Open new topic header at same level as the current one. Negative | |
1889 universal arg means to place the new topic prior to the current | |
1890 one." | |
1891 (interactive "p") | |
1892 (open-topic 0 (> 0 arg))) | |
1893 ;;;_ > open-supertopic (arg) | |
1894 (defun open-supertopic (arg) | |
1895 " Open new topic header at shallower level than the current one. | |
1896 Negative universal arg means to open shallower, but place the new | |
1897 topic prior to the current one." | |
1898 | |
1899 (interactive "p") | |
1900 (open-topic -1 (> 0 arg))) | |
1901 | |
1902 ;;;_ : Outline Alteration | |
1903 ;;;_ . Topic Form Modification | |
1904 ;;;_ > outline-reindent-body (old-depth new-depth) | |
1905 (defun outline-reindent-body (old-depth new-depth) | |
1906 " Reindent body lines which were indented at old-depth to new-depth. | |
1907 | |
1908 Note that refill of indented paragraphs is not done, and tabs are | |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
3549
diff
changeset
|
1909 not accommodated. ('untabify' your outline if you want to preserve |
3430 | 1910 hanging body indents.)" |
1911 | |
1912 (save-excursion | |
1913 (save-restriction | |
1914 (outline-goto-prefix) | |
1915 (forward-char 1) | |
1916 (let* ((old-spaces-expr (make-string (1+ old-depth) ?\ )) | |
1917 (new-spaces-expr (concat (make-string (1+ new-depth) ?\ ) | |
1918 ;; spaces followed by non-space: | |
1919 "\\1"))) | |
1920 (while (and (re-search-forward "[\C-j\C-m]" nil t) | |
1921 (not (looking-at outline-regexp))) | |
1922 (if (looking-at old-spaces-expr) | |
1923 (replace-match new-spaces-expr))))))) | |
1924 ;;;_ > outline-rebullet-current-heading (arg) | |
1925 (defun outline-rebullet-current-heading (arg) | |
1926 " Like non-interactive version 'outline-rebullet-heading', but work on | |
1927 (only) visible heading containing point. | |
1928 | |
1929 With repeat count, solicit for bullet." | |
1930 (interactive "P") | |
1931 (save-excursion (outline-back-to-current-heading) | |
1932 (outline-end-of-prefix) | |
1933 (outline-rebullet-heading (not arg) ;;; solicit | |
1934 nil ;;; depth | |
1935 nil ;;; number-control | |
1936 nil ;;; index | |
1937 t) ;;; do-successors | |
1938 ) | |
1939 ) | |
1940 ;;;_ > outline-rebullet-heading (&optional solicit ...) | |
1941 (defvar current-bullet nil | |
1942 "Variable local to outline-rebullet-heading,but referenced by | |
1943 outline-make-topic-prefix, also. Should be resolved with explicitly | |
1944 parameterized communication between the two, if suitable.") | |
1945 (defun outline-rebullet-heading (&optional solicit | |
1946 new-depth | |
1947 number-control | |
1948 index | |
1949 do-successors) | |
1950 | |
1951 " Adjust bullet of current topic prefix. | |
1952 | |
1953 All args are optional. | |
1954 | |
1955 If SOLICIT is non-nil then the choice of bullet is solicited from | |
1956 user. Otherwise the distinctiveness of the bullet or the topic | |
1957 depth determines it. | |
1958 | |
1959 Second arg DEPTH forces the topic prefix to that depth, regardless | |
1960 of the topic's current depth. | |
1961 | |
1962 Third arg NUMBER-CONTROL can force the prefix to or away from | |
1963 numbered form. It has effect only if 'outline-numbered-bullet' is | |
1964 non-nil and soliciting was not explicitly invoked (via first arg). | |
1965 Its effect, numbering or denumbering, then depends on the setting | |
1966 of the forth arg, INDEX. | |
1967 | |
1968 If NUMBER-CONTROL is non-nil and forth arg INDEX is nil, then the | |
1969 prefix of the topic is forced to be non-numbered. Null index and | |
1970 non-nil NUMBER-CONTROL forces denumbering. Non-nil INDEX (and | |
1971 non-nil NUMBER-CONTROL) forces a numbered-prefix form. If non-nil | |
1972 INDEX is a number, then that number is used for the numbered | |
1973 prefix. Non-nil and non-number means that the index for the | |
1974 numbered prefix will be derived by outline-make-topic-prefix. | |
1975 | |
1976 Fifth arg DO-SUCCESSORS t means re-resolve count on succeeding | |
1977 siblings. | |
1978 | |
1979 Cf vars 'outline-stylish-prefixes', 'outline-old-style-prefixes', | |
1980 and 'outline-numbered-bullet', which all affect the behavior of | |
1981 this function." | |
1982 | |
1983 (let* ((current-depth (outline-depth)) | |
1984 (new-depth (or new-depth current-depth)) | |
1985 (mb outline-recent-prefix-beginning) | |
1986 (me outline-recent-prefix-end) | |
1987 (current-bullet (buffer-substring (- me 1) me)) | |
1988 (new-prefix (outline-make-topic-prefix current-bullet | |
1989 nil | |
1990 new-depth | |
1991 solicit | |
1992 number-control | |
1993 index))) | |
1994 | |
1995 ;; Don't need to reinsert identical one: | |
1996 (if (and (= current-depth new-depth) | |
1997 (string= current-bullet | |
1998 (substring new-prefix (1- (length new-prefix))))) | |
1999 t | |
2000 | |
2001 ;; New prefix probably different from old: | |
2002 ;; get rid of old one: | |
2003 (delete-region mb me) | |
2004 (goto-char mb) | |
2005 ;; Dispense with number if numbered-bullet prefix: | |
2006 (if (and outline-numbered-bullet | |
2007 (string= outline-numbered-bullet current-bullet) | |
2008 (looking-at "[0-9]+")) | |
2009 (delete-region (match-beginning 0)(match-end 0))) | |
2010 | |
2011 ;; Put in new prefix: | |
2012 (insert-string new-prefix) | |
2013 ) | |
2014 | |
2015 ;; Reindent the body if elected and depth changed: | |
2016 (if (and outline-reindent-bodies | |
2017 (not (= new-depth current-depth))) | |
2018 (outline-reindent-body current-depth new-depth)) | |
2019 | |
2020 ;; Recursively rectify successive siblings if selected: | |
2021 (if do-successors | |
2022 (save-excursion | |
2023 (while (outline-next-sibling) | |
2024 (setq index | |
2025 (cond ((numberp index) (1+ index)) | |
2026 ((not number-control) (outline-sibling-index)))) | |
2027 (if (outline-numbered-type-prefix) | |
2028 (outline-rebullet-heading nil ;;; solicit | |
2029 new-depth ;;; new-depth | |
2030 number-control;;; number-control | |
2031 index ;;; index | |
2032 nil))))) ;;;(dont!)do-successors | |
2033 ) | |
2034 ) | |
2035 ;;;_ > outline-rebullet-topic (arg) | |
2036 (defun outline-rebullet-topic (arg) | |
2037 " Like outline-rebullet-topic-grunt, but start from topic visible at point. | |
2038 Descends into invisible as well as visible topics, however. | |
2039 | |
2040 With repeat count, shift topic depth by that amount." | |
2041 (interactive "P") | |
2042 (let ((start-col (current-column)) | |
2043 (was-eol (eolp))) | |
2044 (save-excursion | |
2045 ;; Normalize arg: | |
2046 (cond ((null arg) (setq arg 0)) | |
2047 ((listp arg) (setq arg (car arg)))) | |
2048 ;; Fill the user in, in case we're shifting a big topic: | |
2049 (if (not (zerop arg)) (message "Shifting...")) | |
2050 (outline-back-to-current-heading) | |
2051 (if (<= (+ (outline-recent-depth) arg) 0) | |
2052 (error "Attempt to shift topic below level 1")) | |
2053 (outline-rebullet-topic-grunt arg) | |
2054 (if (not (zerop arg)) (message "Shifting... done."))) | |
2055 (move-to-column (max 0 (+ start-col arg)))) | |
2056 ) | |
2057 ;;;_ > outline-rebullet-topic-grunt (&optional relative-depth ...) | |
2058 (defun outline-rebullet-topic-grunt (&optional relative-depth | |
2059 starting-depth | |
2060 starting-point | |
2061 index | |
2062 do-successors) | |
2063 | |
2064 " Rebullet the topic at point, visible or invisible, and all | |
2065 contained subtopics. See outline-rebullet-heading for rebulleting | |
2066 behavior. | |
2067 | |
2068 All arguments are optional. | |
2069 | |
2070 First arg RELATIVE-DEPTH means to shift the depth of the entire | |
2071 topic that amount. | |
2072 | |
2073 The rest of the args are for internal recursive use by the function | |
2074 itself. The are STARTING-DEPTH, STARTING-POINT, and INDEX." | |
2075 | |
2076 (let* ((relative-depth (or relative-depth 0)) | |
2077 (new-depth (outline-depth)) | |
2078 (starting-depth (or starting-depth new-depth)) | |
2079 (on-starting-call (null starting-point)) | |
2080 (index (or index | |
2081 ;; Leave index null on starting call, so rebullet-heading | |
2082 ;; calculates it at what might be new depth: | |
2083 (and (or (zerop relative-depth) | |
2084 (not on-starting-call)) | |
2085 (outline-sibling-index)))) | |
2086 (moving-outwards (< 0 relative-depth)) | |
2087 (starting-point (or starting-point (point)))) | |
2088 | |
2089 ;; Sanity check for excessive promotion done only on starting call: | |
2090 (and on-starting-call | |
2091 moving-outwards | |
2092 (> 0 (+ starting-depth relative-depth)) | |
2093 (error "Attempt to shift topic out beyond level 1.")) ;;; ====> | |
2094 | |
2095 (cond ((= starting-depth new-depth) | |
2096 ;; We're at depth to work on this one: | |
2097 (outline-rebullet-heading nil ;;; solicit | |
2098 (+ starting-depth ;;; starting-depth | |
2099 relative-depth) | |
2100 nil ;;; number | |
2101 index ;;; index | |
2102 ;; Every contained topic will get hit, | |
2103 ;; and we have to get to outside ones | |
2104 ;; deliberately: | |
2105 nil) ;;; do-successors | |
2106 ;; ... and work on subsequent ones which are at greater depth: | |
2107 (setq index 0) | |
2108 (outline-next-heading) | |
2109 (while (and (not (eobp)) | |
2110 (< starting-depth (outline-recent-depth))) | |
2111 (setq index (1+ index)) | |
2112 (outline-rebullet-topic-grunt relative-depth ;;; relative-depth | |
2113 (1+ starting-depth);;;starting-depth | |
2114 starting-point ;;; starting-point | |
2115 index))) ;;; index | |
2116 | |
2117 ((< starting-depth new-depth) | |
2118 ;; Rare case - subtopic more than one level deeper than parent. | |
2119 ;; Treat this one at an even deeper level: | |
2120 (outline-rebullet-topic-grunt relative-depth ;;; relative-depth | |
2121 new-depth ;;; starting-depth | |
2122 starting-point ;;; starting-point | |
2123 index))) ;;; index | |
2124 | |
2125 (if on-starting-call | |
2126 (progn | |
2127 ;; Rectify numbering of former siblings of the adjusted topic, | |
2128 ;; if topic has changed depth | |
2129 (if (or do-successors | |
2130 (and (not (zerop relative-depth)) | |
2131 (or (= (outline-recent-depth) starting-depth) | |
2132 (= (outline-recent-depth) (+ starting-depth | |
2133 relative-depth))))) | |
2134 (outline-rebullet-heading nil nil nil nil t)) | |
2135 ;; Now rectify numbering of new siblings of the adjusted topic, | |
2136 ;; if depth has been changed: | |
2137 (progn (goto-char starting-point) | |
2138 (if (not (zerop relative-depth)) | |
2139 (outline-rebullet-heading nil nil nil nil t))))) | |
2140 ) | |
2141 ) | |
2142 ;;;_ > outline-number-siblings (&optional denumber) | |
2143 (defun outline-number-siblings (&optional denumber) | |
2144 " Assign numbered topic prefix to this topic and its siblings. | |
2145 | |
2146 With universal argument, denumber - assign default bullet to this | |
2147 topic and its siblings. | |
2148 | |
2149 With repeated universal argument (`^U^U'), solicit bullet for each | |
2150 rebulleting each topic at this level." | |
2151 | |
2152 (interactive "P") | |
2153 | |
2154 (save-excursion | |
2155 (outline-back-to-current-heading) | |
2156 (outline-beginning-of-level) | |
2157 (let ((index (if (not denumber) 1)) | |
2158 (use-bullet (equal '(16) denumber)) | |
2159 (more t)) | |
2160 (while more | |
2161 (outline-rebullet-heading use-bullet ;;; solicit | |
2162 nil ;;; depth | |
2163 t ;;; number-control | |
2164 index ;;; index | |
2165 nil) ;;; do-successors | |
2166 (if index (setq index (1+ index))) | |
2167 (setq more (outline-next-sibling))) | |
2168 ) | |
2169 ) | |
2170 ) | |
2171 ;;;_ > outline-shift-in (arg) | |
2172 (defun outline-shift-in (arg) | |
2173 " Decrease prefix depth of current heading and any topics collapsed | |
2174 within it." | |
2175 (interactive "p") | |
2176 (outline-rebullet-topic arg)) | |
2177 ;;;_ > outline-shift-out (arg) | |
2178 (defun outline-shift-out (arg) | |
2179 " Decrease prefix depth of current heading and any topics collapsed | |
2180 within it." | |
2181 (interactive "p") | |
2182 (outline-rebullet-topic (* arg -1))) | |
2183 ;;;_ . Surgery (kill-ring) functions with special provisions for outlines: | |
2184 ;;;_ > outline-kill-line (&optional arg) | |
2185 (defun outline-kill-line (&optional arg) | |
2186 " Kill line, adjusting subsequent lines suitably for outline mode." | |
2187 | |
2188 (interactive "*P") | |
2189 (if (not (and | |
2190 (boundp 'outline-mode) outline-mode ; active outline mode, | |
2191 outline-numbered-bullet ; numbers may need adjustment, | |
2192 (bolp) ; may be clipping topic head, | |
2193 (looking-at outline-regexp))) ; are clipping topic head. | |
2194 ;; Above conditions do not obtain - just do a regular kill: | |
2195 (kill-line arg) | |
2196 ;; Ah, have to watch out for adjustments: | |
2197 (let* ((depth (outline-depth)) | |
2198 (ascender depth)) | |
2199 (kill-line arg) | |
2200 (sit-for 0) | |
2201 (save-excursion | |
2202 (if (not (looking-at outline-regexp)) | |
2203 (outline-next-heading)) | |
2204 (if (> (outline-depth) depth) | |
2205 ;; An intervening parent was removed from after a subtree: | |
2206 (setq depth (outline-recent-depth))) | |
2207 (while (and (> (outline-depth) 0) | |
2208 (> (outline-recent-depth) ascender) | |
2209 (outline-ascend-to-depth (setq ascender | |
2210 (1- ascender))))) | |
2211 ;; Have to try going forward until we find another at | |
2212 ;; desired depth: | |
2213 (if (and outline-numbered-bullet | |
2214 (outline-descend-to-depth depth)) | |
2215 (outline-rebullet-heading nil ;;; solicit | |
2216 depth ;;; depth | |
2217 nil ;;; number-control | |
2218 nil ;;; index | |
2219 t) ;;; do-successors | |
2220 ) | |
2221 ) | |
2222 ) | |
2223 ) | |
2224 ) | |
2225 ;;;_ > outline-kill-topic () | |
2226 (defun outline-kill-topic () | |
2227 " Kill topic together with subtopics." | |
2228 | |
2229 ;; Some finagling is done to make complex topic kills appear faster | |
2230 ;; than they actually are. A redisplay is performed immediately | |
2231 ;; after the region is disposed of, though the renumbering process | |
2232 ;; has yet to be performed. This means that there may appear to be | |
2233 ;; a lag *after* the kill has been performed. | |
2234 | |
2235 (interactive) | |
2236 (let* ((beg (outline-back-to-current-heading)) | |
2237 (depth (outline-recent-depth))) | |
2238 (outline-end-of-current-subtree) | |
2239 (if (not (eobp)) | |
2240 (forward-char 1)) | |
2241 (kill-region beg (point)) | |
2242 (sit-for 0) | |
2243 (save-excursion | |
2244 (if (and outline-numbered-bullet | |
2245 (outline-descend-to-depth depth)) | |
2246 (outline-rebullet-heading nil ;;; solicit | |
2247 depth ;;; depth | |
2248 nil ;;; number-control | |
2249 nil ;;; index | |
2250 t) ;;; do-successors | |
2251 ) | |
2252 ) | |
2253 ) | |
2254 ) | |
2255 ;;;_ > outline-yank (&optional arg) | |
2256 (defun outline-yank (&optional arg) | |
2257 " Like regular yank, except does depth adjustment of yanked topics, when: | |
2258 | |
2259 1 the stuff being yanked starts with a valid outline header prefix, and | |
2260 2 it is being yanked at the end of a line which consists of only a valid | |
2261 topic prefix. | |
2262 | |
2263 If these two conditions hold then the depth of the yanked topics | |
2264 are all adjusted the amount it takes to make the first one at the | |
2265 depth of the header into which it's being yanked. | |
2266 | |
2267 The point is left in from of yanked, adjusted topics, rather than | |
2268 at the end (and vice-versa with the mark). Non-adjusted yanks, | |
2269 however, (ones that don't qualify for adjustment) are handled | |
2270 exactly like normal yanks. | |
2271 | |
2272 Outline-yank-pop is used with outline-yank just as normal yank-pop | |
2273 is used with normal yank in non-outline buffers." | |
2274 | |
2275 (interactive "*P") | |
2276 (setq this-command 'yank) | |
2277 (if (not (and (boundp 'outline-mode) outline-mode)) | |
2278 | |
2279 ;; Outline irrelevant - just do regular yank: | |
2280 (yank arg) | |
2281 | |
2282 ;; Outline *is* relevant: | |
2283 (let ((beginning (point)) | |
2284 topic-yanked | |
2285 established-depth) ; Depth of the prefix into which we're yanking. | |
2286 ;; Get current depth and numbering ... Oops, not doing anything | |
2287 ;; with the number just yet... | |
2288 (if (and (eolp) | |
2289 (save-excursion (beginning-of-line) | |
2290 (looking-at outline-regexp))) | |
2291 (setq established-depth (- (match-end 0) (match-beginning 0)))) | |
2292 (yank arg) | |
2293 (exchange-dot-and-mark) | |
2294 (if (and established-depth ; the established stuff qualifies. | |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
3549
diff
changeset
|
2295 ;; The yanked stuff also qualifies - is topic(s): |
3430 | 2296 (looking-at (concat "\\(" outline-regexp "\\)"))) |
2297 ;; Ok, adjust the depth of the yanked stuff. Note that the | |
2298 ;; stuff may have more than a single root, so we have to | |
2299 ;; iterate over all the top level ones yanked, and do them in | |
2300 ;; such a way that the adjustment of one new one won't affect | |
2301 ;; any of the other new ones. We use the focus of the | |
2302 ;; narrowed region to successively exclude processed siblings. | |
2303 (let* ((yanked-beg (match-beginning 1)) | |
2304 (yanked-end (match-end 1)) | |
2305 (yanked-bullet (buffer-substring (1- yanked-end) yanked-end)) | |
2306 (yanked-depth (- yanked-end yanked-beg)) | |
2307 (depth-diff (- established-depth yanked-depth)) | |
2308 done | |
2309 (more t)) | |
2310 (setq topic-yanked t) | |
2311 (save-excursion | |
2312 (save-restriction | |
2313 (narrow-to-region yanked-beg (mark)) | |
2314 ;; First trim off excessive blank line at end, if any: | |
2315 (goto-char (point-max)) | |
2316 (if (looking-at "^$") (delete-char -1)) | |
2317 (goto-char (point-min)) | |
2318 ;; Work backwards, with each shallowest level, | |
2319 ;; successively excluding the last processed topic | |
2320 ;; from the narrow region: | |
2321 (goto-char (point-max)) | |
2322 (while more | |
2323 (outline-back-to-current-heading) | |
2324 ;; go as high as we can in each bunch: | |
2325 (while (outline-ascend-to-depth | |
2326 (1- (outline-depth)))) | |
2327 (save-excursion | |
2328 (outline-rebullet-topic-grunt depth-diff | |
2329 (outline-depth) | |
2330 (point))) | |
2331 (if (setq more (not (bobp))) | |
2332 (progn (widen) | |
2333 (forward-char -1) | |
2334 (narrow-to-region yanked-beg (point))))))) | |
2335 ;; Preserve new bullet if it's a distinctive one, otherwise | |
2336 ;; use old one: | |
2337 (if (string-match yanked-bullet outline-distinctive-bullets-string) | |
2338 (delete-region (save-excursion | |
2339 (beginning-of-line) | |
2340 (point)) | |
2341 yanked-beg) | |
2342 (delete-region yanked-beg (+ yanked-beg established-depth)) | |
2343 ;; and extraneous digits and a space: | |
2344 (while (looking-at "[0-9]") (delete-char 1)) | |
2345 (if (looking-at " ") (delete-char 1)) | |
2346 ) | |
2347 (goto-char yanked-beg) | |
2348 ) | |
2349 ;; Not established-depth or looking-at... | |
2350 (setq topic-yanked (looking-at outline-regexp)) | |
2351 (exchange-dot-and-mark)) | |
2352 (if (and topic-yanked outline-numbered-bullet) | |
2353 (progn | |
2354 ;; Renumber, in case necessary: | |
2355 (sit-for 0) | |
2356 (save-excursion | |
2357 (goto-char beginning) | |
2358 (if (outline-goto-prefix) | |
2359 (outline-rebullet-heading nil ;;; solicit | |
2360 (outline-depth) ;;; depth | |
2361 nil ;;; number-control | |
2362 nil ;;; index | |
2363 t) ;;; do-successors | |
2364 ) | |
2365 ) | |
2366 ) | |
2367 ) | |
2368 ) | |
2369 ) | |
2370 ) | |
2371 ;;;_ > outline-yank-pop (&optional arg) | |
2372 (defun outline-yank-pop (&optional arg) | |
2373 " Just like yank-pop, but works like outline-yank when popping | |
2374 topics just after fresh outline prefixes. Adapts level of popped | |
2375 stuff to level of fresh prefix." | |
2376 | |
2377 (interactive "*p") | |
2378 (if (not (eq last-command 'yank)) | |
2379 (error "Previous command was not a yank")) | |
2380 (setq this-command 'yank) | |
2381 (delete-region (point) (mark)) | |
2382 (rotate-yank-pointer arg) | |
2383 (outline-yank) | |
2384 ) | |
2385 | |
2386 ;;;_ : Specialty bullet functions | |
2387 ;;;_ . File Cross references | |
2388 ;;;_ > outline-resolve-xref () | |
2389 (defun outline-resolve-xref () | |
2390 " Pop to file associated with current heading, if it has an xref bullet | |
2391 (according to setting of 'outline-file-xref-bullet')." | |
2392 (interactive) | |
2393 (if (not outline-file-xref-bullet) | |
2394 (error | |
2395 "outline cross references disabled - no 'outline-file-xref-bullet'") | |
2396 (if (not (string= (outline-current-bullet) outline-file-xref-bullet)) | |
2397 (error "current heading lacks cross-reference bullet '%s'" | |
2398 outline-file-xref-bullet) | |
2399 (let (file-name) | |
2400 (save-excursion | |
2401 (let* ((text-start outline-recent-prefix-end) | |
2402 (heading-end (progn (outline-pre-next-preface) | |
2403 (point)))) | |
2404 (goto-char text-start) | |
2405 (setq file-name | |
2406 (if (re-search-forward "\\s-\\(\\S-*\\)" heading-end t) | |
2407 (buffer-substring (match-beginning 1) (match-end 1)))))) | |
2408 (setq file-name | |
2409 (if (not (= (aref file-name 0) ?:)) | |
2410 (expand-file-name file-name) | |
2411 ; A registry-files ref, strip the ':' | |
2412 ; and try to follow it: | |
2413 (let ((reg-ref (reference-registered-file | |
2414 (substring file-name 1) nil t))) | |
2415 (if reg-ref (car (cdr reg-ref)))))) | |
2416 (if (or (file-exists-p file-name) | |
2417 (if (file-writable-p file-name) | |
2418 (y-or-n-p (format "%s not there, create one? " | |
2419 file-name)) | |
2420 (error "%s not found and can't be created" file-name))) | |
2421 (condition-case failure | |
2422 (find-file-other-window file-name) | |
2423 (error failure)) | |
2424 (error "%s not found" file-name)) | |
2425 ) | |
2426 ) | |
2427 ) | |
2428 ) | |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
3549
diff
changeset
|
2429 ;;;_ > outline-to-entry-end - Unmaintained compatibility - ignore this! |
3430 | 2430 ;------------------------------------------------------------------- |
2431 ; Something added solely for use by a "smart menu" package someone got | |
2432 ; off the net. I have no idea whether this is appropriate code. | |
2433 | |
2434 (defvar next-entry-exists nil "Used by outline-to-entry-end, dunno why.") | |
2435 (defun outline-to-entry-end (&optional include-sub-entries curr-entry-level) | |
2436 " Go to end of whole entry if optional INCLUDE-SUB-ENTRIES is non-nil. | |
2437 CURR-ENTRY-LEVEL is an integer representing the length of the current level | |
2438 string which matched to 'outline-regexp'. If INCLUDE-SUB-ENTRIES is nil, | |
2439 CURR-ENTRY-LEVEL is not needed." | |
2440 (while (and (setq next-entry-exists | |
2441 (re-search-forward outline-regexp nil t)) | |
2442 include-sub-entries | |
2443 (save-excursion | |
2444 (beginning-of-line) | |
2445 (> (outline-depth) curr-entry-level)))) | |
2446 (if next-entry-exists | |
2447 (progn (beginning-of-line) (point)) | |
2448 (goto-char (point-max)))) | |
2449 ;;; Outline topic prefix and level adjustment funcs: | |
2450 | |
2451 ;;;_ #6 miscellaneous | |
2452 ;;;_ > outline-copy-exposed (&optional workbuf) | |
2453 (defun outline-copy-exposed (&optional workbuf) | |
2454 " Duplicate buffer to other buffer, sans hidden stuff. | |
2455 | |
2456 Without repeat count, this simple-minded function just generates | |
2457 the new buffer by concatenating the current buffer name with \" | |
2458 exposed\", and doing a 'get-buffer' on it." | |
2459 | |
2460 (interactive) | |
2461 (if (not workbuf) (setq workbuf (concat (buffer-name) " exposed"))) | |
2462 (let ((buf (current-buffer))) | |
2463 (if (not (get-buffer workbuf)) | |
2464 (generate-new-buffer workbuf)) | |
2465 (pop-to-buffer workbuf) | |
2466 (erase-buffer) | |
2467 (insert-buffer buf) | |
5310
fe3bea12d381
(outline-copy-exposed): Don't use replace-regexp.
Richard M. Stallman <rms@gnu.org>
parents:
3591
diff
changeset
|
2468 ;; (replace-regexp "\^M[^\^M\^J]*" "") |
fe3bea12d381
(outline-copy-exposed): Don't use replace-regexp.
Richard M. Stallman <rms@gnu.org>
parents:
3591
diff
changeset
|
2469 (while (re-search-forward "\^M[^\^M\^J]*" nil t) |
fe3bea12d381
(outline-copy-exposed): Don't use replace-regexp.
Richard M. Stallman <rms@gnu.org>
parents:
3591
diff
changeset
|
2470 (replace-match "" nil nil)) |
3430 | 2471 (goto-char (point-min)) |
2472 ) | |
2473 ) | |
3549
a4d9c9bc3994
(outlinify-sticky): Renamed from outlineify-sticky.
Richard M. Stallman <rms@gnu.org>
parents:
3430
diff
changeset
|
2474 ;;;_ > outlinify-sticky () |
a4d9c9bc3994
(outlinify-sticky): Renamed from outlineify-sticky.
Richard M. Stallman <rms@gnu.org>
parents:
3430
diff
changeset
|
2475 (defun outlinify-sticky (&optional arg) |
3430 | 2476 " Activate outline mode and establish file eval to set initial exposure. |
2477 | |
2478 Invoke with a string argument to designate a string to prepend to | |
2479 topic prefixs, or with a universal argument to be prompted for the | |
2480 string to be used. Suitable defaults are provided for lisp, | |
2481 emacs-lisp, c, c++, awk, sh, csh, and perl modes." | |
2482 | |
2483 (interactive "P") (outline-mode t) | |
2484 (cond (arg | |
2485 (if (stringp arg) | |
2486 ;; Use arg as the header-prefix: | |
2487 (outline-lead-with-comment-string arg) | |
2488 ;; Otherwise, let function solicit string: | |
2489 (setq arg (outline-lead-with-comment-string)))) | |
2490 ((member major-mode '(emacs-lisp-mode lisp-mode)) | |
2491 (setq arg (outline-lead-with-comment-string ";;;_"))) | |
2492 ((member major-mode '(awk-mode csh-mode sh-mode perl-mode)) | |
2493 ;; Bare '#' (ie, not '#_') so we don't break the magic number: | |
2494 (setq arg (outline-lead-with-comment-string "#"))) | |
2495 ((eq major-mode 'c++-mode) | |
2496 (setq arg (outline-lead-with-comment-string "//_"))) | |
2497 ((eq major-mode 'c-mode) | |
2498 ;; User's will have to know to close off the comments: | |
2499 (setq arg (outline-lead-with-comment-string "/*_")))) | |
2500 (let* ((lead-prefix (format "%s%s" | |
2501 (concat outline-header-prefix (if arg " " "")) | |
2502 outline-primary-bullet)) | |
2503 (lead-line (format "%s%s %s\n%s %s\n %s %s %s" | |
2504 (if arg outline-header-prefix "") | |
2505 outline-primary-bullet | |
2506 "Local emacs vars." | |
2507 "'(This topic sets initial outline exposure" | |
2508 "of the file when loaded by emacs," | |
2509 "Encapsulate it in comments if" | |
2510 "file is a program" | |
2511 "otherwise ignore it,"))) | |
2512 | |
2513 (save-excursion | |
2514 ; Put a topic at the top, if | |
2515 ; none there already: | |
2516 (goto-char (point-min)) | |
2517 (if (not (looking-at outline-regexp)) | |
2518 (insert-string | |
2519 (if (not arg) outline-primary-bullet | |
2520 (format "%s%s\n" outline-header-prefix outline-primary-bullet)))) | |
2521 | |
2522 ; File-vars stuff, at the bottom: | |
2523 (goto-char (point-max)) | |
2524 ; Insert preamble: | |
2525 (insert-string (format "\n\n%s\n%s %s %s\n%s %s " | |
2526 lead-line | |
2527 lead-prefix | |
2528 "local" | |
2529 "variables:" | |
2530 lead-prefix | |
2531 "eval:")) | |
2532 ; Insert outline-mode activation: | |
2533 (insert-string | |
2534 (format "%s\n\t\t%s\n\t\t\t%s\n" | |
2535 "(condition-case err" | |
2536 "(save-excursion" | |
2537 "(outline-mode t)")) | |
2538 ; Conditionally insert prefix | |
2539 ; leader customization: | |
2540 (if arg (insert-string (format "\t\t\t(%s \"%s\")\n" | |
2541 "outline-lead-with-comment-string" | |
2542 arg))) | |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
3549
diff
changeset
|
2543 ; Insert announcement and |
3430 | 2544 ; exposure control: |
2545 (insert-string | |
2546 (format "\t\t\t%s %s\n\t\t\t%s %s\n\t\t%s %s" | |
2547 "(message \"Adjusting '%s' visibility\"" | |
2548 "(buffer-name))" | |
2549 "(goto-char 0)" | |
2550 "(outline-exposure -1 0))" | |
2551 "(error (message " | |
2552 "\"Failed file var 'allout' provisions\")))")) | |
2553 ; Insert postamble: | |
2554 (insert-string (format "\n%s End: )\n" | |
2555 lead-prefix))))) | |
2556 ;;;_ > solicit-char-in-string (prompt string &optional do-defaulting) | |
2557 (defun solicit-char-in-string (prompt string &optional do-defaulting) | |
2558 " Solicit (with first arg PROMPT) choice of a character from string STRING. | |
2559 | |
2560 Optional arg DO-DEFAULTING indicates to accept empty input (CR)." | |
2561 | |
2562 (let ((new-prompt prompt) | |
2563 got) | |
2564 | |
2565 (while (not got) | |
2566 (message "%s" new-prompt) | |
2567 | |
2568 ;; We do our own reading here, so we can circumvent, eg, special | |
2569 ;; treatment for '?' character. (Might oughta change minibuffer | |
2570 ;; keymap instead, oh well.) | |
2571 (setq got | |
2572 (char-to-string (let ((cursor-in-echo-area t)) (read-char)))) | |
2573 | |
2574 (if (null (string-match got string)) | |
2575 (if (and do-defaulting (string= got "\^M")) | |
2576 ;; We're defaulting, return null string to indicate that: | |
2577 (setq got "") | |
2578 ;; Failed match and not defaulting, | |
2579 ;; set the prompt to give feedback, | |
2580 (setq new-prompt (concat prompt | |
2581 got | |
2582 " ...pick from: " | |
2583 string | |
2584 "")) | |
2585 ;; and set loop to try again: | |
2586 (setq got nil)) | |
2587 ;; Got a match - give feedback: | |
2588 (message ""))) | |
2589 ;; got something out of loop - return it: | |
2590 got) | |
2591 ) | |
2592 ;;;_ > string-sans-char (string char) | |
2593 (defun string-sans-char (string char) | |
2594 " Return a copy of STRING that lacks all instances of CHAR." | |
2595 (cond ((string= string "") "") | |
2596 ((= (aref string 0) char) (string-sans-char (substring string 1) char)) | |
2597 ((concat (substring string 0 1) | |
2598 (string-sans-char (substring string 1) char))))) | |
2599 | |
2600 ;;;_* Local emacs vars. | |
2601 '( | |
2602 Local variables: | |
2603 eval: (save-excursion | |
2604 (if (not (condition-case err (outline-mode t) | |
2605 (wrong-number-of-arguments nil))) | |
2606 (progn | |
2607 (message | |
2608 "Allout outline-mode not loaded, not adjusting buffer exposure") | |
2609 (sit-for 1)) | |
2610 (message "Adjusting '%s' visibility" (buffer-name)) | |
2611 (outline-lead-with-comment-string ";;;_") | |
2612 (goto-char 0) | |
2613 (outline-exposure (-1 () () () 1) 0))) | |
2614 End: | |
2615 ) | |
2616 |