Mercurial > emacs
annotate lisp/allout.el @ 5020:94de08fd8a7c
(Fnext_single_property_change): Fix missing \n\.
| author | Richard M. Stallman <rms@gnu.org> |
|---|---|
| date | Mon, 15 Nov 1993 06:41:45 +0000 |
| parents | 507f64624555 |
| children | fe3bea12d381 |
| 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 | |
|
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
3549
diff
changeset
|
14 ;;;_ - Version: $Id: allout.el,v 1.2 1993/06/07 18:48:08 rms Exp jimb $|| |
| 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 | |
|
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
3549
diff
changeset
|
22 ;; |27-May-1993|$Id: allout.el,v 1.2 1993/06/07 18:48:08 rms Exp jimb $|| |
| 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) | |
| 2468 (replace-regexp "\^M[^\^M\^J]*" "") | |
| 2469 (goto-char (point-min)) | |
| 2470 ) | |
| 2471 ) | |
|
3549
a4d9c9bc3994
(outlinify-sticky): Renamed from outlineify-sticky.
Richard M. Stallman <rms@gnu.org>
parents:
3430
diff
changeset
|
2472 ;;;_ > outlinify-sticky () |
|
a4d9c9bc3994
(outlinify-sticky): Renamed from outlineify-sticky.
Richard M. Stallman <rms@gnu.org>
parents:
3430
diff
changeset
|
2473 (defun outlinify-sticky (&optional arg) |
| 3430 | 2474 " Activate outline mode and establish file eval to set initial exposure. |
| 2475 | |
| 2476 Invoke with a string argument to designate a string to prepend to | |
| 2477 topic prefixs, or with a universal argument to be prompted for the | |
| 2478 string to be used. Suitable defaults are provided for lisp, | |
| 2479 emacs-lisp, c, c++, awk, sh, csh, and perl modes." | |
| 2480 | |
| 2481 (interactive "P") (outline-mode t) | |
| 2482 (cond (arg | |
| 2483 (if (stringp arg) | |
| 2484 ;; Use arg as the header-prefix: | |
| 2485 (outline-lead-with-comment-string arg) | |
| 2486 ;; Otherwise, let function solicit string: | |
| 2487 (setq arg (outline-lead-with-comment-string)))) | |
| 2488 ((member major-mode '(emacs-lisp-mode lisp-mode)) | |
| 2489 (setq arg (outline-lead-with-comment-string ";;;_"))) | |
| 2490 ((member major-mode '(awk-mode csh-mode sh-mode perl-mode)) | |
| 2491 ;; Bare '#' (ie, not '#_') so we don't break the magic number: | |
| 2492 (setq arg (outline-lead-with-comment-string "#"))) | |
| 2493 ((eq major-mode 'c++-mode) | |
| 2494 (setq arg (outline-lead-with-comment-string "//_"))) | |
| 2495 ((eq major-mode 'c-mode) | |
| 2496 ;; User's will have to know to close off the comments: | |
| 2497 (setq arg (outline-lead-with-comment-string "/*_")))) | |
| 2498 (let* ((lead-prefix (format "%s%s" | |
| 2499 (concat outline-header-prefix (if arg " " "")) | |
| 2500 outline-primary-bullet)) | |
| 2501 (lead-line (format "%s%s %s\n%s %s\n %s %s %s" | |
| 2502 (if arg outline-header-prefix "") | |
| 2503 outline-primary-bullet | |
| 2504 "Local emacs vars." | |
| 2505 "'(This topic sets initial outline exposure" | |
| 2506 "of the file when loaded by emacs," | |
| 2507 "Encapsulate it in comments if" | |
| 2508 "file is a program" | |
| 2509 "otherwise ignore it,"))) | |
| 2510 | |
| 2511 (save-excursion | |
| 2512 ; Put a topic at the top, if | |
| 2513 ; none there already: | |
| 2514 (goto-char (point-min)) | |
| 2515 (if (not (looking-at outline-regexp)) | |
| 2516 (insert-string | |
| 2517 (if (not arg) outline-primary-bullet | |
| 2518 (format "%s%s\n" outline-header-prefix outline-primary-bullet)))) | |
| 2519 | |
| 2520 ; File-vars stuff, at the bottom: | |
| 2521 (goto-char (point-max)) | |
| 2522 ; Insert preamble: | |
| 2523 (insert-string (format "\n\n%s\n%s %s %s\n%s %s " | |
| 2524 lead-line | |
| 2525 lead-prefix | |
| 2526 "local" | |
| 2527 "variables:" | |
| 2528 lead-prefix | |
| 2529 "eval:")) | |
| 2530 ; Insert outline-mode activation: | |
| 2531 (insert-string | |
| 2532 (format "%s\n\t\t%s\n\t\t\t%s\n" | |
| 2533 "(condition-case err" | |
| 2534 "(save-excursion" | |
| 2535 "(outline-mode t)")) | |
| 2536 ; Conditionally insert prefix | |
| 2537 ; leader customization: | |
| 2538 (if arg (insert-string (format "\t\t\t(%s \"%s\")\n" | |
| 2539 "outline-lead-with-comment-string" | |
| 2540 arg))) | |
|
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
3549
diff
changeset
|
2541 ; Insert announcement and |
| 3430 | 2542 ; exposure control: |
| 2543 (insert-string | |
| 2544 (format "\t\t\t%s %s\n\t\t\t%s %s\n\t\t%s %s" | |
| 2545 "(message \"Adjusting '%s' visibility\"" | |
| 2546 "(buffer-name))" | |
| 2547 "(goto-char 0)" | |
| 2548 "(outline-exposure -1 0))" | |
| 2549 "(error (message " | |
| 2550 "\"Failed file var 'allout' provisions\")))")) | |
| 2551 ; Insert postamble: | |
| 2552 (insert-string (format "\n%s End: )\n" | |
| 2553 lead-prefix))))) | |
| 2554 ;;;_ > solicit-char-in-string (prompt string &optional do-defaulting) | |
| 2555 (defun solicit-char-in-string (prompt string &optional do-defaulting) | |
| 2556 " Solicit (with first arg PROMPT) choice of a character from string STRING. | |
| 2557 | |
| 2558 Optional arg DO-DEFAULTING indicates to accept empty input (CR)." | |
| 2559 | |
| 2560 (let ((new-prompt prompt) | |
| 2561 got) | |
| 2562 | |
| 2563 (while (not got) | |
| 2564 (message "%s" new-prompt) | |
| 2565 | |
| 2566 ;; We do our own reading here, so we can circumvent, eg, special | |
| 2567 ;; treatment for '?' character. (Might oughta change minibuffer | |
| 2568 ;; keymap instead, oh well.) | |
| 2569 (setq got | |
| 2570 (char-to-string (let ((cursor-in-echo-area t)) (read-char)))) | |
| 2571 | |
| 2572 (if (null (string-match got string)) | |
| 2573 (if (and do-defaulting (string= got "\^M")) | |
| 2574 ;; We're defaulting, return null string to indicate that: | |
| 2575 (setq got "") | |
| 2576 ;; Failed match and not defaulting, | |
| 2577 ;; set the prompt to give feedback, | |
| 2578 (setq new-prompt (concat prompt | |
| 2579 got | |
| 2580 " ...pick from: " | |
| 2581 string | |
| 2582 "")) | |
| 2583 ;; and set loop to try again: | |
| 2584 (setq got nil)) | |
| 2585 ;; Got a match - give feedback: | |
| 2586 (message ""))) | |
| 2587 ;; got something out of loop - return it: | |
| 2588 got) | |
| 2589 ) | |
| 2590 ;;;_ > string-sans-char (string char) | |
| 2591 (defun string-sans-char (string char) | |
| 2592 " Return a copy of STRING that lacks all instances of CHAR." | |
| 2593 (cond ((string= string "") "") | |
| 2594 ((= (aref string 0) char) (string-sans-char (substring string 1) char)) | |
| 2595 ((concat (substring string 0 1) | |
| 2596 (string-sans-char (substring string 1) char))))) | |
| 2597 | |
| 2598 ;;;_* Local emacs vars. | |
| 2599 '( | |
| 2600 Local variables: | |
| 2601 eval: (save-excursion | |
| 2602 (if (not (condition-case err (outline-mode t) | |
| 2603 (wrong-number-of-arguments nil))) | |
| 2604 (progn | |
| 2605 (message | |
| 2606 "Allout outline-mode not loaded, not adjusting buffer exposure") | |
| 2607 (sit-for 1)) | |
| 2608 (message "Adjusting '%s' visibility" (buffer-name)) | |
| 2609 (outline-lead-with-comment-string ";;;_") | |
| 2610 (goto-char 0) | |
| 2611 (outline-exposure (-1 () () () 1) 0))) | |
| 2612 End: | |
| 2613 ) | |
| 2614 |
