1;;;_* allout.el - Extensive outline mode for use alone and with other modes. 2 3;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. 4 5;; Author: Ken Manheimer <klm@nist.gov> 6;; Maintainer: Ken Manheimer <klm@nist.gov> 7;; Created: Dec 1991 - first release to usenet 8;; Version: Id: allout.el,v 4.3 1994/05/12 17:43:08 klm Exp || 9;; Keywords: outline mode 10 11;; This file is part of GNU Emacs. 12 13;; GNU Emacs is free software; you can redistribute it and/or modify 14;; it under the terms of the GNU General Public License as published by 15;; the Free Software Foundation; either version 2, or (at your option) 16;; any later version. 17 18;; GNU Emacs is distributed in the hope that it will be useful, 19;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21;; GNU General Public License for more details. 22 23;; You should have received a copy of the GNU General Public License 24;; along with GNU Emacs; see the file COPYING. If not, write to 25;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 26 27;;;_* Commentary: 28 29;; Allout outline mode provides extensive outline formatting and 30;; manipulation capabilities, subsuming and well beyond that of 31;; standard emacs outline mode. It is specifically aimed at 32;; supporting outline structuring and manipulation of syntax- 33;; sensitive text, eg programming languages. (For an example, see the 34;; allout code itself, which is organized in outline structure.) 35;; 36;; It also includes such things as topic-oriented repositioning, cut, and 37;; paste; integral outline exposure-layout; incremental search with 38;; dynamic exposure/conceament of concealed text; automatic topic-number 39;; maintenance; and many other features. 40;; 41;; See the docstring of the variables `outline-layout' and 42;; `outline-auto-activation' for details on automatic activation of 43;; allout outline-mode as a minor mode. (It has changed since allout 44;; 3.x, for those of you that depend on the old method.) 45;; 46;; Note - the lines beginning with ';;;_' are outline topic headers. 47;; Just 'ESC-x eval-current-buffer' to give it a whirl. 48 49;;Ken Manheimer 301 975-3539 50;;ken.manheimer@nist.gov FAX: 301 963-9137 51;; 52;;Computer Systems and Communications Division 53;; 54;; Nat'l Institute of Standards and Technology 55;; Technology A151 56;; Gaithersburg, MD 20899 57 58;;;_* Provide 59(provide 'outline) 60(provide 'allout) 61 62;;;_* USER CUSTOMIZATION VARIABLES: 63 64;;;_ + Layout, Mode, and Topic Header Configuration 65 66;;;_ = outline-auto-activation 67(defvar outline-auto-activation nil 68 "*Regulates auto-activation modality of allout outlines - see `outline-init'. 69 70Setq-default by `outline-init' to regulate whether or not allout 71outline mode is automatically activated when the buffer-specific 72variable `outline-layout' is non-nil, and whether or not the layout 73dictated by `outline-layout' should be imposed on mode activation. 74 75With value `t', auto-mode-activation and auto-layout are enabled. 76\(This also depends on `outline-find-file-hooks' being installed in 77`find-file-hooks', which is also done by `outline-init'.) 78 79With value `ask', auto-mode-activation is enabled, and endorsement for 80performing auto-layout is asked of the user each time. 81 82With value `activate', only auto-mode-activation is enabled, auto- 83layout is not. 84 85With value `nil', neither auto-mode-activation nor auto-layout are 86enabled. 87 88See the docstring for `outline-init' for the proper interface to 89this variable.") 90;;;_ = outline-layout 91(defvar outline-layout nil 92 "*Layout specification and provisional mode trigger for allout outlines. 93 94Buffer-specific. 95 96A list value specifies a default layout for the current buffer, to be 97applied upon activation of allout outline-mode. Any non-nil value 98will automatically trigger allout outline-mode, provided `outline- 99init' has been called to enable it. 100 101See the docstring for `outline-init' for details on setting up for 102auto-mode-activation, and for `outline-expose-topic' for the format of 103the layout specification. 104 105You can associate a particular outline layout with a file by setting 106this var via the file's local variables. For example, the following 107lines at the bottom of an elisp file: 108 109;;;Local variables: 110;;;outline-layout: \(0 : -1 -1 0\) 111;;;End: 112 113will, modulo the above-mentioned conditions, cause the mode to be 114activated when the file is visited, followed by the equivalent of 115`\(outline-expose-topic 0 : -1 -1 0\)'. \(This is the layout used for 116the allout.el, itself.) 117 118Also, allout's mode-specific provisions will make topic prefixes 119default to the comment-start string, if any, of the language of the 120file. This is modulo the setting of `outline-use-mode-specific- 121leader', which see.") 122(make-variable-buffer-local 'outline-layout) 123 124;;;_ = outline-header-prefix 125(defvar outline-header-prefix "." 126 "*Leading string which helps distinguish topic headers. 127 128Outline topic header lines are identified by a leading topic 129header prefix, which mostly have the value of this var at their front. 130\(Level 1 topics are exceptions. They consist of only a single 131character, which is typically set to the outline-primary-bullet. Many 132outlines start at level 2 to avoid this discrepancy.") 133(make-variable-buffer-local 'outline-header-prefix) 134;;;_ = outline-primary-bullet 135(defvar outline-primary-bullet "*" 136 "Bullet used for top-level outline topics. 137 138Outline topic header lines are identified by a leading topic header 139prefix, which is concluded by bullets that includes the value of this 140var and the respective outline-*-bullets-string vars. 141 142The value of an asterisk ('*') provides for backwards compatability 143with the original emacs outline mode. See outline-plain-bullets-string 144and outline-distinctive-bullets-string for the range of available 145bullets.") 146(make-variable-buffer-local 'outline-primary-bullet) 147;;;_ = outline-plain-bullets-string 148(defvar outline-plain-bullets-string (concat outline-primary-bullet 149 "+-:.;,") 150 "*The bullets normally used in outline topic prefixes. 151 152See 'outline-distinctive-bullets-string' for the other kind of 153bullets. 154 155DO NOT include the close-square-bracket, ']', as a bullet. 156 157Outline mode has to be reactivated in order for changes to the value 158of this var to take effect.") 159(make-variable-buffer-local 'outline-plain-bullets-string) 160;;;_ = outline-distinctive-bullets-string 161(defvar outline-distinctive-bullets-string "=>([{}&!?#%\"X@$~\\" 162 "*Persistent outline header bullets used to distinguish special topics. 163 164These bullets are not offered among the regular, level-specific 165rotation, and are not altered by automatic rebulleting, as when 166shifting the level of a topic. See `outline-plain-bullets-string' for 167the selection of alternating bullets. 168 169You must run 'set-outline-regexp' in order for changes 170to the value of this var to effect outline-mode operation. 171 172DO NOT include the close-square-bracket, ']', on either of the bullet 173strings.") 174(make-variable-buffer-local 'outline-distinctive-bullets-string) 175 176;;;_ = outline-use-mode-specific-leader 177(defvar outline-use-mode-specific-leader t 178 "*When non-nil, use mode-specific topic-header prefixes. 179 180Allout outline mode will use the mode-specific `outline-mode-leaders' 181and/or comment-start string, if any, to lead the topic prefix string, 182so topic headers look like comments in the programming language. 183 184String values are used as they stand. 185 186Value `t' means to first check for assoc value in `outline-mode-leaders' 187alist, then use comment-start string, if any, then use default \(`.'). 188\(See note about use of comment-start strings, below.\) 189 190Set to the symbol for either of `outline-mode-leaders' or 191`comment-start' to use only one of them, respectively. 192 193Value `nil' means to always use the default \(`.'\). 194 195comment-start strings that do not end in spaces are tripled, and an 196'_' underscore is tacked on the end, to distinguish them from regular 197comment strings. comment-start strings that do end in spaces are not 198tripled, but an underscore is substituted for the space. \[This 199presumes that the space is for appearance, not comment syntax. You 200can use `outline-mode-leaders' to override this behavior, when 201incorrect.\]") 202;;;_ = outline-mode-leaders 203(defvar outline-mode-leaders '() 204 "Specific outline-prefix leading strings per major modes. 205 206Entries will be used in the stead (or lieu) of mode-specific 207comment-start strings. See also `outline-use-mode-specific-leader'. 208 209If you're constructing a string that will comment-out outline 210structuring so it can be included in program code, append an extra 211character, like an \"_\" underscore, to distinguish the lead string 212from regular comments that start at bol.") 213 214;;;_ = outline-old-style-prefixes 215(defvar outline-old-style-prefixes nil 216 "*When non-nil, use only old-and-crusty outline-mode '*' topic prefixes. 217 218Non-nil restricts the topic creation and modification 219functions to asterix-padded prefixes, so they look exactly 220like the original emacs-outline style prefixes. 221 222Whatever the setting of this variable, both old and new style prefixes 223are always respected by the topic maneuvering functions.") 224(make-variable-buffer-local 'outline-old-style-prefixes) 225;;;_ = outline-stylish-prefixes - alternating bullets 226(defvar outline-stylish-prefixes t 227 "*Do fancy stuff with topic prefix bullets according to level, etc. 228 229Non-nil enables topic creation, modification, and repositioning 230functions to vary the topic bullet char (the char that marks the topic 231depth) just preceding the start of the topic text) according to level. 232Otherwise, only asterisks ('*') and distinctive bullets are used. 233 234This is how an outline can look (but sans indentation) with stylish 235prefixes: 236 237 * Top level 238 .* A topic 239 . + One level 3 subtopic 240 . . One level 4 subtopic 241 . . A second 4 subtopic 242 . + Another level 3 subtopic 243 . #1 A numbered level 4 subtopic 244 . #2 Another 245 . ! Another level 4 subtopic with a different distinctive bullet 246 . #4 And another numbered level 4 subtopic 247 248This would be an outline with stylish prefixes inhibited (but the 249numbered and other distinctive bullets retained): 250 251 * Top level 252 .* A topic 253 . * One level 3 subtopic 254 . * One level 4 subtopic 255 . * A second 4 subtopic 256 . * Another level 3 subtopic 257 . #1 A numbered level 4 subtopic 258 . #2 Another 259 . ! Another level 4 subtopic with a different distinctive bullet 260 . #4 And another numbered level 4 subtopic 261 262Stylish and constant prefixes (as well as old-style prefixes) are 263always respected by the topic maneuvering functions, regardless of 264this variable setting. 265 266The setting of this var is not relevant when outline-old-style-prefixes 267is non-nil.") 268(make-variable-buffer-local 'outline-stylish-prefixes) 269 270;;;_ = outline-numbered-bullet 271(defvar outline-numbered-bullet "#" 272 "*String designating bullet of topics that have auto-numbering; nil for none. 273 274Topics having this bullet have automatic maintainence of a sibling 275sequence-number tacked on, just after the bullet. Conventionally set 276to \"#\", you can set it to a bullet of your choice. A nil value 277disables numbering maintainence.") 278(make-variable-buffer-local 'outline-numbered-bullet) 279;;;_ = outline-file-xref-bullet 280(defvar outline-file-xref-bullet "@" 281 "*Bullet signifying file cross-references, for `outline-resolve-xref'. 282 283Set this var to the bullet you want to use for file cross-references. 284Set it 'nil' if you want to inhibit this capability.") 285 286;;;_ + LaTeX formatting 287;;;_ - outline-number-pages 288(defvar outline-number-pages nil 289 "*Non-nil turns on page numbering for LaTeX formatting of an outline.") 290;;;_ - outline-label-style 291(defvar outline-label-style "\\large\\bf" 292 "*Font and size of labels for LaTeX formatting of an outline.") 293;;;_ - outline-head-line-style 294(defvar outline-head-line-style "\\large\\sl " 295 "*Font and size of entries for LaTeX formatting of an outline.") 296;;;_ - outline-body-line-style 297(defvar outline-body-line-style " " 298 "*Font and size of entries for LaTeX formatting of an outline.") 299;;;_ - outline-title-style 300(defvar outline-title-style "\\Large\\bf" 301 "*Font and size of titles for LaTeX formatting of an outline.") 302;;;_ - outline-title 303(defvar outline-title '(or buffer-file-name (current-buffer-name)) 304 "*Expression to be evaluated to determine the title for LaTeX 305formatted copy.") 306;;;_ - outline-line-skip 307(defvar outline-line-skip ".05cm" 308 "*Space between lines for LaTeX formatting of an outline.") 309;;;_ - outline-indent 310(defvar outline-indent ".3cm" 311 "*LaTeX formatted depth-indent spacing.") 312 313;;;_ + Miscellaneous customization 314 315;;;_ = outline-keybindings-list 316;;; You have to reactivate outline-mode - '(outline-mode t)' - to 317;;; institute changes to this var. 318(defvar outline-keybindings-list () 319 "*List of outline-mode key / function bindings. 320 321These bindings will be locally bound on the outline-mode-map. The 322keys will be prefixed by outline-command-prefix, unless the cell 323contains a third, no-nil element, in which case the initial string 324will be used as is.") 325(setq outline-keybindings-list 326 '( 327 ; Motion commands: 328 ("?t" outline-latexify-exposed) 329 ("\C-n" outline-next-visible-heading) 330 ("\C-p" outline-previous-visible-heading) 331 ("\C-u" outline-up-current-level) 332 ("\C-f" outline-forward-current-level) 333 ("\C-b" outline-backward-current-level) 334 ("\C-a" outline-beginning-of-current-entry) 335 ("\C-e" outline-end-of-current-entry) 336 ;;("\C-n" outline-next-line-or-topic) 337 ;;("\C-p" outline-previous-line-or-topic) 338 ; Exposure commands: 339 ("\C-i" outline-show-children) 340 ("\C-s" outline-show-current-subtree) 341 ("\C-h" outline-hide-current-subtree) 342 ("\C-o" outline-show-current-entry) 343 ("!" outline-show-all) 344 ; Alteration commands: 345 (" " outline-open-sibtopic) 346 ("." outline-open-subtopic) 347 ("," outline-open-supertopic) 348 ("'" outline-shift-in) 349 (">" outline-shift-in) 350 ("<" outline-shift-out) 351 ("\C-m" outline-rebullet-topic) 352 ("b" outline-rebullet-current-heading) 353 ("#" outline-number-siblings) 354 ("\C-k" outline-kill-line t) 355 ("\C-y" outline-yank t) 356 ("\M-y" outline-yank-pop t) 357 ("\C-k" outline-kill-topic) 358 ; Miscellaneous commands: 359 ("\C-@" outline-mark-topic) 360 ("@" outline-resolve-xref) 361 ("?c" outline-copy-exposed))) 362 363;;;_ = outline-command-prefix 364(defvar outline-command-prefix "\C-c" 365 "*Key sequence to be used as prefix for outline mode command key bindings.") 366 367;;;_ = outline-enwrap-isearch-mode 368(defvar outline-enwrap-isearch-mode t 369 "*Set non-nil to enable automatic exposure of concealed isearch targets. 370 371If non-nil, isearch will expose hidden text encountered in the course 372of a search, and to reconceal it if the search is continued past it.") 373 374;;;_ = outline-use-hanging-indents 375(defvar outline-use-hanging-indents t 376 "*If non-nil, topic body text auto-indent defaults to indent of the header. 377Ie, it is indented to be just past the header prefix. This is 378relevant mostly for use with indented-text-mode, or other situations 379where auto-fill occurs. 380 381[This feature no longer depends in any way on the 'filladapt.el' 382lisp-archive package.]") 383(make-variable-buffer-local 'outline-use-hanging-indents) 384 385;;;_ = outline-reindent-bodies 386(defvar outline-reindent-bodies (if outline-use-hanging-indents 387 'text) 388 "*Non-nil enables auto-adjust of topic body hanging indent with depth shifts. 389 390When active, topic body lines that are indented even with or beyond 391their topic header are reindented to correspond with depth shifts of 392the header. 393 394A value of `t' enables reindent in non-programming-code buffers, ie 395those that do not have the variable `comment-start' set. A value of 396`force' enables reindent whether or not `comment-start' is set.") 397 398(make-variable-buffer-local 'outline-reindent-bodies) 399 400;;;_ = outline-inhibit-protection 401(defvar outline-inhibit-protection nil 402 "*Non-nil disables warnings and confirmation-checks for concealed-text edits. 403 404Outline mode uses emacs change-triggered functions to detect unruly 405changes to concealed regions. Set this var non-nil to disable the 406protection, potentially increasing text-entry responsiveness a bit. 407 408This var takes effect at outline-mode activation, so you may have to 409deactivate and then reactivate the mode if you want to toggle the 410behavior.") 411 412;;;_* CODE - no user customizations below. 413 414;;;_ #1 Internal Outline Formatting and Configuration 415;;;_ - Version 416;;;_ = outline-version 417(defvar outline-version 418 (let ((rcs-rev "Revision: 4.3")) 419 (condition-case err 420 (save-match-data 421 (string-match "Revision: \\([0-9]+\\.[0-9]+\\)" rcs-rev) 422 (substring rcs-rev (match-beginning 1) (match-end 1))) 423 (error rcs-rev))) 424 "Revision number of currently loaded outline package. \(allout.el)") 425;;;_ > outline-version 426(defun outline-version (&optional here) 427 "Return string describing the loaded outline version." 428 (interactive "P") 429 (let ((msg (concat "Allout Outline Mode v " outline-version))) 430 (if here (insert-string msg)) 431 (message "%s" msg) 432 msg)) 433;;;_ - Topic header format 434;;;_ = outline-regexp 435(defvar outline-regexp "" 436 "*Regular expression to match the beginning of a heading line. 437 438Any line whose beginning matches this regexp is considered a 439heading. This var is set according to the user configuration vars 440by set-outline-regexp.") 441(make-variable-buffer-local 'outline-regexp) 442;;;_ = outline-bullets-string 443(defvar outline-bullets-string "" 444 "A string dictating the valid set of outline topic bullets. 445 446This var should *not* be set by the user - it is set by 'set-outline-regexp', 447and is produced from the elements of 'outline-plain-bullets-string' 448and 'outline-distinctive-bullets-string'.") 449(make-variable-buffer-local 'outline-bullets-string) 450;;;_ = outline-bullets-string-len 451(defvar outline-bullets-string-len 0 452 "Length of current buffers' outline-plain-bullets-string.") 453(make-variable-buffer-local 'outline-bullets-string-len) 454;;;_ = outline-line-boundary-regexp 455(defvar outline-line-boundary-regexp () 456 "Outline-regexp with outline-style beginning-of-line anchor. 457 458\(Ie, C-j, *or* C-m, for prefixes of hidden topics). This is properly 459set when outline-regexp is produced by 'set-outline-regexp', so 460that (match-beginning 2) and (match-end 2) delimit the prefix.") 461(make-variable-buffer-local 'outline-line-boundary-regexp) 462;;;_ = outline-bob-regexp 463(defvar outline-bob-regexp () 464 "Like outline-line-boundary-regexp, for headers at beginning of buffer. 465\(match-beginning 2) and (match-end 2) delimit the prefix.") 466(make-variable-buffer-local 'outline-bob-regexp) 467;;;_ = outline-header-subtraction 468(defvar outline-header-subtraction (1- (length outline-header-prefix)) 469 "Outline-header prefix length to subtract when computing topic depth.") 470(make-variable-buffer-local 'outline-header-subtraction) 471;;;_ = outline-plain-bullets-string-len 472(defvar outline-plain-bullets-string-len (length outline-plain-bullets-string) 473 "Length of outline-plain-bullets-string, updated by set-outline-regexp.") 474(make-variable-buffer-local 'outline-plain-bullets-string-len) 475 476 477;;;_ X outline-reset-header-lead (header-lead) 478(defun outline-reset-header-lead (header-lead) 479 "*Reset the leading string used to identify topic headers." 480 (interactive "sNew lead string: ") 481 (setq outline-header-prefix header-lead) 482 (setq outline-header-subtraction (1- (length outline-header-prefix))) 483 (set-outline-regexp)) 484;;;_ X outline-lead-with-comment-string (header-lead) 485(defun outline-lead-with-comment-string (&optional header-lead) 486 "*Set the topic-header leading string to specified string. 487 488Useful when for encapsulating outline structure in programming 489language comments. Returns the leading string." 490 491 (interactive "P") 492 (if (not (stringp header-lead)) 493 (setq header-lead (read-string 494 "String prefix for topic headers: "))) 495 (setq outline-reindent-bodies nil) 496 (outline-reset-header-lead header-lead) 497 header-lead) 498;;;_ > outline-infer-header-lead () 499(defun outline-infer-header-lead () 500 "Determine appropriate `outline-header-prefix'. 501 502Works according to settings of: 503 504 `comment-start' 505 `outline-header-prefix' (default) 506 `outline-use-mode-specific-leader' 507and `outline-mode-leaders'. 508 509Apply this via \(re\)activation of `outline-mode', rather than 510invoking it directly." 511 (let* ((use-leader (and (boundp 'outline-use-mode-specific-leader) 512 (if (or (stringp outline-use-mode-specific-leader) 513 (memq outline-use-mode-specific-leader 514 '(outline-mode-leaders 515 comment-start 516 t))) 517 outline-use-mode-specific-leader 518 ;; Oops - garbled value, equate with effect of 't: 519 t))) 520 (leader 521 (cond 522 ((not use-leader) nil) 523 ;; Use the explicitly designated leader: 524 ((stringp use-leader) use-leader) 525 (t (or (and (memq use-leader '(t outline-mode-leaders)) 526 ;; Get it from outline mode leaders? 527 (cdr (assq major-mode outline-mode-leaders))) 528 ;; ... didn't get from outline-mode-leaders... 529 (and (memq use-leader '(t comment-start)) 530 comment-start 531 ;; Use comment-start, maybe tripled, and with 532 ;; underscore: 533 (concat 534 (if (string= " " 535 (substring comment-start 536 (1- (length comment-start)))) 537 ;; Use comment-start, sans trailing space: 538 (substring comment-start 0 -1) 539 (concat comment-start comment-start comment-start)) 540 ;; ... and append underscore, whichever: 541 "_"))))))) 542 (if (not leader) 543 nil 544 (if (string= leader outline-header-prefix) 545 nil ; no change, nothing to do. 546 (setq outline-header-prefix leader) 547 outline-header-prefix)))) 548;;;_ > outline-infer-body-reindent () 549(defun outline-infer-body-reindent () 550 "Determine proper setting for `outline-reindent-bodies'. 551 552Depends on default setting of `outline-reindent-bodies' \(which see) 553and presence of setting for `comment-start', to tell whether the 554file is programming code." 555 (if (and outline-reindent-bodies 556 comment-start 557 (not (eq 'force outline-reindent-bodies))) 558 (setq outline-reindent-bodies nil))) 559;;;_ > set-outline-regexp () 560(defun set-outline-regexp () 561 "Generate proper topic-header regexp form for outline functions. 562 563Works with respect to `outline-plain-bullets-string' and 564`outline-distinctive-bullets-string'." 565 566 (interactive) 567 ;; Derive outline-bullets-string from user configured components: 568 (setq outline-bullets-string "") 569 (let ((strings (list 'outline-plain-bullets-string 570 'outline-distinctive-bullets-string)) 571 cur-string 572 cur-len 573 cur-char 574 cur-char-string 575 index 576 new-string) 577 (while strings 578 (setq new-string "") (setq index 0) 579 (setq cur-len (length (setq cur-string (symbol-value (car strings))))) 580 (while (< index cur-len) 581 (setq cur-char (aref cur-string index)) 582 (setq outline-bullets-string 583 (concat outline-bullets-string 584 (cond 585 ; Single dash would denote a 586 ; sequence, repeated denotes 587 ; a dash: 588 ((eq cur-char ?-) "--") 589 ; literal close-square-bracket 590 ; doesn't work right in the 591 ; expr, exclude it: 592 ((eq cur-char ?\]) "") 593 (t (regexp-quote (char-to-string cur-char)))))) 594 (setq index (1+ index))) 595 (setq strings (cdr strings))) 596 ) 597 ;; Derive next for repeated use in outline-pending-bullet: 598 (setq outline-plain-bullets-string-len (length outline-plain-bullets-string)) 599 (setq outline-header-subtraction (1- (length outline-header-prefix))) 600 ;; Produce the new outline-regexp: 601 (setq outline-regexp (concat "\\(\\" 602 outline-header-prefix 603 "[ \t]*[" 604 outline-bullets-string 605 "]\\)\\|\\" 606 outline-primary-bullet 607 "+\\|\^l")) 608 (setq outline-line-boundary-regexp 609 (concat "\\([\n\r]\\)\\(" outline-regexp "\\)")) 610 (setq outline-bob-regexp 611 (concat "\\(\\`\\)\\(" outline-regexp "\\)")) 612 ) 613;;;_ - Key bindings 614;;;_ = outline-mode-map 615(defvar outline-mode-map nil "Keybindings for (allout) outline minor mode.") 616;;;_ > produce-outline-mode-map (keymap-alist &optional base-map) 617(defun produce-outline-mode-map (keymap-list &optional base-map) 618 "Produce keymap for use as outline-mode-map, from keymap-list. 619 620Built on top of optional BASE-MAP, or empty sparse map if none specified. 621See doc string for outline-keybindings-list for format of binding list." 622 (let ((map (or base-map (make-sparse-keymap)))) 623 (mapcar (lambda (cell) 624 (apply 'define-key map (if (null (cdr (cdr cell))) 625 (cons (concat outline-command-prefix 626 (car cell)) 627 (cdr cell)) 628 (list (car cell) (car (cdr cell)))))) 629 keymap-list) 630 map)) 631;;;_ = outline-prior-bindings - being deprecated. 632(defvar outline-prior-bindings nil 633 "Variable for use in V18, with outline-added-bindings, for 634resurrecting, on mode deactivation, bindings that existed before 635activation. Being deprecated.") 636;;;_ = outline-added-bindings - being deprecated 637(defvar outline-added-bindings nil 638 "Variable for use in V18, with outline-prior-bindings, for 639resurrecting, on mode deactivation, bindings that existed before 640activation. Being deprecated.") 641;;;_ - Mode-Specific Variable Maintenance Utilities 642;;;_ = outline-mode-prior-settings 643(defvar outline-mode-prior-settings nil 644 "Internal outline mode use; settings to be resumed on mode deactivation.") 645(make-variable-buffer-local 'outline-mode-prior-settings) 646;;;_ > outline-resumptions (name &optional value) 647(defun outline-resumptions (name &optional value) 648 649 "Registers or resumes settings over outline-mode activation/deactivation. 650 651First arg is NAME of variable affected. Optional second arg is list 652containing outline-mode-specific VALUE to be imposed on named 653variable, and to be registered. (It's a list so you can specify 654registrations of null values.) If no value is specified, the 655registered value is returned (encapsulated in the list, so the caller 656can distinguish nil vs no value), and the registration is popped 657from the list." 658 659 (let ((on-list (assq name outline-mode-prior-settings)) 660 prior-capsule ; By 'capsule' i mean a list 661 ; containing a value, so we can 662 ; distinguish nil from no value. 663 ) 664 665 (if value 666 667 ;; Registering: 668 (progn 669 (if on-list 670 nil ; Already preserved prior value - don't mess with it. 671 ;; Register the old value, or nil if previously unbound: 672 (setq outline-mode-prior-settings 673 (cons (list name 674 (if (boundp name) (list (symbol-value name)))) 675 outline-mode-prior-settings))) 676 ; And impose the new value, locally: 677 (progn (make-local-variable name) 678 (set name (car value)))) 679 680 ;; Relinquishing: 681 (if (not on-list) 682 683 ;; Oops, not registered - leave it be: 684 nil 685 686 ;; Some registration: 687 ; reestablish it: 688 (setq prior-capsule (car (cdr on-list))) 689 (if prior-capsule 690 (set name (car prior-capsule)) ; Some prior value - reestablish it. 691 (makunbound name)) ; Previously unbound - demolish var. 692 ; Remove registration: 693 (let (rebuild) 694 (while outline-mode-prior-settings 695 (if (not (eq (car outline-mode-prior-settings) 696 on-list)) 697 (setq rebuild 698 (cons (car outline-mode-prior-settings) 699 rebuild))) 700 (setq outline-mode-prior-settings 701 (cdr outline-mode-prior-settings))) 702 (setq outline-mode-prior-settings rebuild))))) 703 ) 704;;;_ - Mode-specific incidentals 705;;;_ = outline-during-write-cue nil 706(defvar outline-during-write-cue nil 707 "Used to inhibit outline change-protection during file write. 708 709See also `outline-post-command-business', `outline-write-file-hook', 710`outline-before-change-protect', and `outline-post-command-business' 711functions.") 712;;;_ = outline-override-protect nil 713(defvar outline-override-protect nil 714 "Used in outline-mode for regulate of concealed-text protection mechanism. 715 716Allout outline mode regulates alteration of concealed text to protect 717against inadvertant, unnoticed changes. This is for use by specific, 718native outline functions to temporarily override that protection. 719It's automatically reset to nil after every buffer modification.") 720(make-variable-buffer-local 'outline-override-protect) 721;;;_ > outline-unprotected (expr) 722(defmacro outline-unprotected (expr) 723 "Evaluate EXPRESSION with `outline-override-protect' let-bound 't'." 724 (` (let ((outline-override-protect t)) 725 (, expr)))) 726;;;_ = outline-undo-aggregation 727(defvar outline-undo-aggregation 30 728 "Amount of successive self-insert actions to bunch together per undo. 729 730This is purely a kludge variable, regulating the compensation for a bug in 731the way that before-change-function and undo interact.") 732(make-variable-buffer-local 'outline-undo-aggregation) 733;;;_ = file-var-bug hack 734(defvar outline-v18/9-file-var-hack nil 735 "Horrible hack used to prevent invalid multiple triggering of outline 736mode from prop-line file-var activation. Used by outline-mode function 737to track repeats.") 738;;;_ > outline-write-file-hook () 739(defun outline-write-file-hook () 740 "In outline mode, run as a local-write-file-hooks activity. 741 742Currently just sets 'outline-during-write-cue', so outline-change- 743protection knows to keep inactive during file write." 744 (setq outline-during-write-cue t) 745 nil) 746 747;;;_ #2 Mode activation 748;;;_ = outline-mode 749(defvar outline-mode () "Allout outline mode minor-mode flag.") 750(make-variable-buffer-local 'outline-mode) 751;;;_ > outline-mode-p () 752(defmacro outline-mode-p () 753 "Return t if outline-mode is active in current buffer." 754 'outline-mode) 755;;;_ = outline-explicitly-deactivated 756(defvar outline-explicitly-deactivated nil 757 "Outline-mode was last deliberately deactived. 758So outline-post-command-business should not reactivate it...") 759(make-variable-buffer-local 'outline-explicitly-deactivated) 760;;;_ > outline-init (&optional mode) 761(defun outline-init (&optional mode) 762 "Prime outline-mode to enable/disable auto-activation, wrt `outline-layout'. 763 764MODE is one of the following symbols: 765 766 - nil \(or no argument) deactivate auto-activation/layou; 767 - 'activate', enable auto-activation only; 768 - 'ask', enable auto-activation, and enable auto-layout but with 769 confirmation for layout operation solicitated from user each time; 770 - 'report', just report and return the current auto-activation state; 771 - anything else \(eg, t) for auto-activation and auto-layout, without 772 any confirmation check. 773 774Use this function to setup your emacs session for automatic activation 775of allout outline mode, contingent to the buffer-specific setting of 776the `outline-layout' variable. (See `outline-layout' and 777`outline-expose-topic' docstrings for more details on auto layout). 778 779`outline-init' works by setting up (or removing) the outline-mode 780find-file-hook, and giving `outline-auto-activation' a suitable 781setting. 782 783To prime your emacs session for full auto-outline operation, include 784the following two lines in your emacs init file: 785 786\(require 'allout) 787\(outline-init t)" 788 789 (interactive) 790 (if (interactive-p) 791 (progn 792 (setq mode 793 (completing-read 794 (concat "Select outline auto setup mode " 795 "(empty for report, ? for options) ") 796 '(("nil")("full")("activate")("deactivate") 797 ("ask") ("report") ("")) 798 nil 799 t)) 800 (if (string= mode "") 801 (setq mode 'report) 802 (setq mode (intern-soft mode))))) 803 (let 804 ;; convenience aliases, for consistent ref to respective vars: 805 ((hook 'outline-find-file-hook) 806 (curr-mode 'outline-auto-activation)) 807 808 (cond ((not mode) 809 (setq find-file-hooks (delq hook find-file-hooks)) 810 (if (interactive-p) 811 (message "Allout outline mode auto-activation inhibited."))) 812 ((eq mode 'report) 813 (if (not (memq hook find-file-hooks)) 814 (outline-init nil) 815 ;; Just punt and use the reports from each of the modes: 816 (outline-init (symbol-value curr-mode)))) 817 (t (add-hook 'find-file-hooks hook) 818 (set curr-mode ; 'set', not 'setq'! 819 (cond ((eq mode 'activate) 820 (message 821 "Outline mode auto-activation enabled.") 822 'activate) 823 ((eq mode 'report) 824 ;; Return the current mode setting: 825 (outline-init mode)) 826 ((eq mode 'ask) 827 (message 828 (concat "Outline mode auto-activation and " 829 "-layout \(upon confirmation) enabled.")) 830 'ask) 831 ((message 832 "Outline mode auto-activation and -layout enabled.") 833 'full))))))) 834 835;;;_ > outline-mode (&optional toggle) 836;;;_ : Defun: 837(defun outline-mode (&optional toggle) 838;;;_ . Doc string: 839 "Toggle minor mode for controlling exposure and editing of text outlines. 840 841Optional arg forces mode reactivation iff arg is positive num or symbol. 842 843Allout outline mode provides extensive outline formatting and 844manipulation capabilities. It is specifically aimed at supporting 845outline structuring and manipulation of syntax-sensitive text, eg 846programming languages. \(For an example, see the allout code itself, 847which is organized in outline structure.\) 848 849It also includes such things as topic-oriented repositioning, cut, and 850paste; integral outline exposure-layout; incremental search with 851dynamic exposure/conceament of concealed text; automatic topic-number 852maintenance; and many other features. 853 854See the docstring of the variable `outline-init' for instructions on 855priming your emacs session for automatic activation of outline-mode, 856according to file-var settings of the `outline-layout' variable. 857 858Below is a description of the bindings, and then explanation of 859special outline-mode features and terminology. 860 861The bindings themselves are established according to the values of 862variables `outline-keybindings-list' and `outline-command-prefix', 863each time the mode is invoked. Prior bindings are resurrected when 864the mode is revoked. 865 866 Navigation: Exposure Control: 867 ---------- ---------------- 868C-c C-n outline-next-visible-heading | C-c C-h outline-hide-current-subtree 869C-c C-p outline-previous-visible-heading | C-c C-i outline-show-children 870C-c C-u outline-up-current-level | C-c C-s outline-show-current-subtree 871C-c C-f outline-forward-current-level | C-c C-o outline-show-current-entry 872C-c C-b outline-backward-current-level | ^U C-c C-s outline-show-all 873C-c C-e outline-end-of-current-entry | outline-hide-current-leaves 874C-c C-a outline-beginning-of-current-entry, alternately, goes to hot-spot 875 876 Topic Header Production: 877 ----------------------- 878C-c<SP> outline-open-sibtopic Create a new sibling after current topic. 879C-c . outline-open-subtopic ... an offspring of current topic. 880C-c , outline-open-supertopic ... a sibling of the current topic's parent. 881 882 Topic Level and Prefix Adjustment: 883 --------------------------------- 884C-c > outline-shift-in Shift current topic and all offspring deeper. 885C-c < outline-shift-out ... less deep. 886C-c<CR> outline-rebullet-topic Reconcile bullets of topic and its' offspring 887 - distinctive bullets are not changed, others 888 alternated according to nesting depth. 889C-c b outline-rebullet-current-heading Prompt for alternate bullet for 890 current topic. 891C-c # outline-number-siblings Number bullets of topic and siblings - the 892 offspring are not affected. With repeat 893 count, revoke numbering. 894 895 Topic-oriented Killing and Yanking: 896 ---------------------------------- 897C-c C-k outline-kill-topic Kill current topic, including offspring. 898C-k outline-kill-line Like kill-line, but reconciles numbering, etc. 899C-y outline-yank Yank, adjusting depth of yanked topic to 900 depth of heading if yanking into bare topic 901 heading (ie, prefix sans text). 902M-y outline-yank-pop Is to outline-yank as yank-pop is to yank 903 904 Misc commands: 905 ------------- 906C-c @ outline-resolve-xref pop-to-buffer named by xref (cf 907 outline-file-xref-bullet) 908C-c c outline-copy-exposed Copy current topic outline sans concealed 909 text, to buffer with name derived from 910 current buffer - \"XXX exposed\" 911M-x outlineify-sticky Activate outline mode for current buffer, 912 and establish a default file-var setting 913 for `outline-layout'. 914ESC ESC (outline-init t) Setup emacs session for outline mode 915 auto-activation. 916 917 HOT-SPOT Operation 918 919Hot-spot operation provides a means for easy, single-keystroke outline 920navigation and exposure control. 921 922\\<outline-mode-map> 923When the text cursor is positioned directly on the bullet character of 924a topic, regular characters (a to z) invoke the commands of the 925corresponding outline-mode keymap control chars. For example, \"f\" 926would invoke the command typically bound to \"C-c C-f\" 927\(\\[outline-forward-current-level] `outline-forward-current-level'). 928 929Thus, by positioning the cursor on a topic bullet, you can execute 930the outline navigation and manipulation commands with a single 931keystroke. Non-literal chars never get this special translation, so 932you can use them to get away from the hot-spot, and back to normal 933operation. 934 935Note that the command `outline-beginning-of-current-entry' \(\\[outline-beginning-of-current-entry]\) 936will move to the hot-spot when the cursor is already located at the 937beginning of the current entry, so you can simply hit \\[outline-beginning-of-current-entry] 938twice in a row to get to the hot-spot. 939 940 Terminology 941 942Topic hierarchy constituents - TOPICS and SUBTOPICS: 943 944TOPIC: A basic, coherent component of an emacs outline. It can 945 contain other topics, and it can be subsumed by other topics, 946CURRENT topic: 947 The visible topic most immediately containing the cursor. 948DEPTH: The degree of nesting of a topic; it increases with 949 containment. Also called the: 950LEVEL: The same as DEPTH. 951 952ANCESTORS: 953 The topics that contain a topic. 954PARENT: A topic's immediate ancestor. It has a depth one less than 955 the topic. 956OFFSPRING: 957 The topics contained by a topic; 958SUBTOPIC: 959 An immediate offspring of a topic; 960CHILDREN: 961 The immediate offspring of a topic. 962SIBLINGS: 963 Topics having the same parent and depth. 964 965Topic text constituents: 966 967HEADER: The first line of a topic, include the topic PREFIX and header 968 text. 969PREFIX: The leading text of a topic which which distinguishes it from 970 normal text. It has a strict form, which consists of a 971 prefix-lead string, padding, and a bullet. The bullet may be 972 followed by a number, indicating the ordinal number of the 973 topic among its siblings, a space, and then the header text. 974 975 The relative length of the PREFIX determines the nesting depth 976 of the topic. 977PREFIX-LEAD: 978 The string at the beginning of a topic prefix, normally a '.'. 979 It can be customized by changing the setting of 980 `outline-header-prefix' and then reinitializing outline-mode. 981 982 By setting the prefix-lead to the comment-string of a 983 programming language, you can embed outline-structuring in 984 program code without interfering with the language processing 985 of that code. See `outline-use-mode-specific-leader' 986 docstring for more detail. 987PREFIX-PADDING: 988 Spaces or asterisks which separate the prefix-lead and the 989 bullet, according to the depth of the topic. 990BULLET: A character at the end of the topic prefix, it must be one of 991 the characters listed on 'outline-plain-bullets-string' or 992 'outline-distinctive-bullets-string'. (See the documentation 993 for these variables for more details.) The default choice of 994 bullet when generating varies in a cycle with the depth of the 995 topic. 996ENTRY: The text contained in a topic before any offspring. 997BODY: Same as ENTRY. 998 999 1000EXPOSURE: 1001 The state of a topic which determines the on-screen visibility 1002 of its' offspring and contained text. 1003CONCEALED: 1004 Topics and entry text whose display is inhibited. Contiguous 1005 units of concealed text is represented by '...' ellipses. 1006 (Ref the 'selective-display' var.) 1007 1008 Concealed topics are effectively collapsed within an ancestor. 1009CLOSED: A topic whose immediate offspring and body-text is concealed. 1010OPEN: A topic that is not closed, though its' offspring or body may be." 1011;;;_ . Code 1012 (interactive "P") 1013 1014 (let* ((active (and (not (equal major-mode 'outline)) 1015 (outline-mode-p))) 1016 ; Massage universal-arg 'toggle' val: 1017 (toggle (and toggle 1018 (or (and (listp toggle)(car toggle)) 1019 toggle))) 1020 ; Activation specficially demanded? 1021 (explicit-activation (or 1022 ;; 1023 (and toggle 1024 (or (symbolp toggle) 1025 (and (natnump toggle) 1026 (not (zerop toggle))))))) 1027 ;; outline-mode already called once during this complex command? 1028 (same-complex-command (eq outline-v18/9-file-var-hack 1029 (car command-history))) 1030 do-layout 1031 ) 1032 1033 ; See comments below re v19.18,.19 bug. 1034 (setq outline-v18/9-file-var-hack (car command-history)) 1035 1036 (cond 1037 1038 ;; Provision for v19.18, 19.19 bug - 1039 ;; Emacs v 19.18, 19.19 file-var code invokes prop-line-designated 1040 ;; modes twice when file is visited. We have to avoid toggling mode 1041 ;; off on second invocation, so we detect it as best we can, and 1042 ;; skip everything. 1043 ((and same-complex-command ; Still in same complex command 1044 ; as last time outline-mode invoked. 1045 active ; Already activated. 1046 (not explicit-activation) ; Prop-line file-vars don't have args. 1047 (string-match "^19.1[89]" ; Bug only known to be in v19.18 and 1048 emacs-version)); 19.19. 1049 t) 1050 1051 ;; Deactivation: 1052 ((and (not explicit-activation) 1053 (or active toggle)) 1054 ; Activation not explicitly 1055 ; requested, and either in 1056 ; active state or *de*activation 1057 ; specifically requested: 1058 (setq outline-explicitly-deactivated t) 1059 (if (string-match "^18\." emacs-version) 1060 ; Revoke those keys that remain 1061 ; as we set them: 1062 (let ((curr-loc (current-local-map))) 1063 (mapcar '(lambda (cell) 1064 (if (eq (lookup-key curr-loc (car cell)) 1065 (car (cdr cell))) 1066 (define-key curr-loc (car cell) 1067 (assq (car cell) outline-prior-bindings)))) 1068 outline-added-bindings) 1069 (outline-resumptions 'outline-added-bindings) 1070 (outline-resumptions 'outline-prior-bindings))) 1071 1072 (if outline-old-style-prefixes 1073 (progn 1074 (outline-resumptions 'outline-primary-bullet) 1075 (outline-resumptions 'outline-old-style-prefixes))) 1076 (outline-resumptions 'selective-display) 1077 (if (and (boundp 'before-change-function) before-change-function) 1078 (outline-resumptions 'before-change-function)) 1079 (setq pre-command-hook (delq 'outline-pre-command-business 1080 pre-command-hook)) 1081 (setq local-write-file-hooks 1082 (delq 'outline-write-file-hook 1083 local-write-file-hooks)) 1084 (outline-resumptions 'paragraph-start) 1085 (outline-resumptions 'paragraph-separate) 1086 (outline-resumptions (if (string-match "^18" emacs-version) 1087 'auto-fill-hook 1088 'auto-fill-function)) 1089 (outline-resumptions 'outline-former-auto-filler) 1090 (setq outline-mode nil)) 1091 1092 ;; Activation: 1093 ((not active) 1094 (setq outline-explicitly-deactivated nil) 1095 (if outline-old-style-prefixes 1096 (progn ; Inhibit all the fancy formatting: 1097 (outline-resumptions 'outline-primary-bullet '("*")) 1098 (outline-resumptions 'outline-old-style-prefixes '(())))) 1099 1100 (outline-infer-header-lead) 1101 (outline-infer-body-reindent) 1102 1103 (set-outline-regexp) 1104 1105 ; Produce map from current version 1106 ; of outline-keybindings-list: 1107 (if (boundp 'minor-mode-map-alist) 1108 1109 (progn ; V19, and maybe lucid and 1110 ; epoch, minor-mode key bindings: 1111 (setq outline-mode-map 1112 (produce-outline-mode-map outline-keybindings-list)) 1113 (fset 'outline-mode-map outline-mode-map) 1114 ; Include on minor-mode-map-alist, 1115 ; if not already there: 1116 (if (not (member '(outline-mode . outline-mode-map) 1117 minor-mode-map-alist)) 1118 (setq minor-mode-map-alist 1119 (cons '(outline-mode . outline-mode-map) 1120 minor-mode-map-alist)))) 1121 1122 ; V18 minor-mode key bindings: 1123 ; Stash record of added bindings 1124 ; for later revocation: 1125 (outline-resumptions 'outline-added-bindings 1126 (list outline-keybindings-list)) 1127 (outline-resumptions 'outline-prior-bindings 1128 (list (current-local-map))) 1129 ; and add them: 1130 (use-local-map (produce-outline-mode-map outline-keybindings-list 1131 (current-local-map))) 1132 ) 1133 1134 ; selective-display is the 1135 ; emacs conditional exposure 1136 ; mechanism: 1137 (outline-resumptions 'selective-display '(t)) 1138 (if outline-inhibit-protection 1139 t 1140 (outline-resumptions 'before-change-function 1141 '(outline-before-change-protect))) 1142 ; Temporarily set by any outline 1143 ; functions that can be trusted to 1144 ; deal properly with concealed text. 1145 (add-hook 'local-write-file-hooks 'outline-write-file-hook) 1146 ; Custom auto-fill func, to support 1147 ; respect for topic headline, 1148 ; hanging-indents, etc: 1149 (let* ((fill-func-var (if (string-match "^18" emacs-version) 1150 'auto-fill-hook 1151 'auto-fill-function)) 1152 (fill-func (symbol-value fill-func-var))) 1153 ;; Register prevailing fill func for use by outline-auto-fill: 1154 (outline-resumptions 'outline-former-auto-filler (list fill-func)) 1155 ;; Register outline-auto-fill to be used if filling is active: 1156 (outline-resumptions fill-func-var '(outline-auto-fill))) 1157 ;; Paragraphs are broken by topic headlines. 1158 (make-local-variable 'paragraph-start) 1159 (outline-resumptions 'paragraph-start 1160 (list (concat paragraph-start "\\|^\\(" 1161 outline-regexp "\\)"))) 1162 (make-local-variable 'paragraph-separate) 1163 (outline-resumptions 'paragraph-separate 1164 (list (concat paragraph-separate "\\|^\\(" 1165 outline-regexp "\\)"))) 1166 1167 (or (assq 'outline-mode minor-mode-alist) 1168 (setq minor-mode-alist 1169 (cons '(outline-mode " Outl") minor-mode-alist))) 1170 1171 (if outline-layout 1172 (setq do-layout t)) 1173 1174 (if outline-enwrap-isearch-mode 1175 (outline-enwrap-isearch)) 1176 1177 (run-hooks 'outline-mode-hook) 1178 (setq outline-mode t)) 1179 1180 ;; Reactivation: 1181 ((setq do-layout t) 1182 (outline-infer-body-reindent)) 1183 ) ; cond 1184 1185 (if (and do-layout 1186 outline-auto-activation 1187 (listp outline-layout) 1188 (and (not (eq outline-auto-activation 'activate)) 1189 (if (eq outline-auto-activation 'ask) 1190 (if (y-or-n-p (format "Expose %s with layout '%s'? " 1191 (buffer-name) 1192 outline-layout)) 1193 t 1194 (message "Skipped %s layout." (buffer-name)) 1195 nil) 1196 t))) 1197 (save-excursion 1198 (message "Adjusting '%s' exposure..." (buffer-name)) 1199 (goto-char 0) 1200 (outline-this-or-next-heading) 1201 (condition-case err 1202 (progn 1203 (apply 'outline-expose-topic (list outline-layout)) 1204 (message "Adjusting '%s' exposure... done." (buffer-name))) 1205 ;; Problem applying exposure - notify user, but don't 1206 ;; interrupt, eg, file visit: 1207 (error (message "%s" (car (cdr err))) 1208 (sit-for 1))))) 1209 outline-mode 1210 ) ; let* 1211 ) ; defun 1212 1213;;;_ #3 Internal Position State-Tracking - "outline-recent-*" funcs 1214;;; All the basic outline functions that directly do string matches to 1215;;; evaluate heading prefix location set the variables 1216;;; `outline-recent-prefix-beginning' and `outline-recent-prefix-end' 1217;;; when successful. Functions starting with `outline-recent-' all 1218;;; use this state, providing the means to avoid redundant searches 1219;;; for just-established data. This optimization can provide 1220;;; significant speed improvement, but it must be employed carefully. 1221;;;_ = outline-recent-prefix-beginning 1222(defvar outline-recent-prefix-beginning 0 1223 "Buffer point of the start of the last topic prefix encountered.") 1224(make-variable-buffer-local 'outline-recent-prefix-beginning) 1225;;;_ = outline-recent-prefix-end 1226(defvar outline-recent-prefix-end 0 1227 "Buffer point of the end of the last topic prefix encountered.") 1228(make-variable-buffer-local 'outline-recent-prefix-end) 1229;;;_ = outline-recent-end-of-subtree 1230(defvar outline-recent-end-of-subtree 0 1231 "Buffer point last returned by outline-end-of-current-subtree.") 1232(make-variable-buffer-local 'outline-recent-end-of-subtree) 1233;;;_ > outline-prefix-data (beg end) 1234(defmacro outline-prefix-data (beg end) 1235 "Register outline-prefix state data - BEGINNING and END of prefix. 1236 1237For reference by 'outline-recent' funcs. Returns BEGINNING." 1238 (` (setq outline-recent-prefix-end (, end) 1239 outline-recent-prefix-beginning (, beg)))) 1240;;;_ > outline-recent-depth () 1241(defmacro outline-recent-depth () 1242 "Return depth of last heading encountered by an outline maneuvering function. 1243 1244All outline functions which directly do string matches to assess 1245headings set the variables outline-recent-prefix-beginning and 1246outline-recent-prefix-end if successful. This function uses those settings 1247to return the current depth." 1248 1249 '(max 1 (- outline-recent-prefix-end 1250 outline-recent-prefix-beginning 1251 outline-header-subtraction))) 1252;;;_ > outline-recent-prefix () 1253(defmacro outline-recent-prefix () 1254 "Like outline-recent-depth, but returns text of last encountered prefix. 1255 1256All outline functions which directly do string matches to assess 1257headings set the variables outline-recent-prefix-beginning and 1258outline-recent-prefix-end if successful. This function uses those settings 1259to return the current depth." 1260 '(buffer-substring outline-recent-prefix-beginning 1261 outline-recent-prefix-end)) 1262;;;_ > outline-recent-bullet () 1263(defmacro outline-recent-bullet () 1264 "Like outline-recent-prefix, but returns bullet of last encountered prefix. 1265 1266All outline functions which directly do string matches to assess 1267headings set the variables outline-recent-prefix-beginning and 1268outline-recent-prefix-end if successful. This function uses those settings 1269to return the current depth of the most recently matched topic." 1270 '(buffer-substring (1- outline-recent-prefix-end) 1271 outline-recent-prefix-end)) 1272 1273;;;_ #4 Navigation 1274 1275;;;_ - Position Assessment 1276;;;_ : Location Predicates 1277;;;_ > outline-on-current-heading-p () 1278(defun outline-on-current-heading-p () 1279 "Return non-nil if point is on current visible topics' header line. 1280 1281Actually, returns prefix beginning point." 1282 (save-excursion 1283 (beginning-of-line) 1284 (and (looking-at outline-regexp) 1285 (outline-prefix-data (match-beginning 0) (match-end 0))))) 1286;;;_ > outline-e-o-prefix-p () 1287(defun outline-e-o-prefix-p () 1288 "True if point is located where current topic prefix ends, heading begins." 1289 (and (save-excursion (beginning-of-line) 1290 (looking-at outline-regexp)) 1291 (= (point)(save-excursion (outline-end-of-prefix)(point))))) 1292;;;_ > outline-hidden-p () 1293(defmacro outline-hidden-p () 1294 "True if point is in hidden text." 1295 '(save-excursion 1296 (and (re-search-backward "[\n\r]" () t) 1297 (= ?\r (following-char))))) 1298;;;_ > outline-visible-p () 1299(defmacro outline-visible-p () 1300 "True if point is not in hidden text." 1301 (interactive) 1302 '(not (outline-hidden-p))) 1303;;;_ : Location attributes 1304;;;_ > outline-depth () 1305(defmacro outline-depth () 1306 "Like outline-current-depth, but respects hidden as well as visible topics." 1307 '(save-excursion 1308 (if (outline-goto-prefix) 1309 (outline-recent-depth) 1310 (progn 1311 ;; Oops, no prefix, zero prefix data: 1312 (outline-prefix-data (point)(point)) 1313 ;; ... and return 0: 1314 0)))) 1315;;;_ > outline-current-depth () 1316(defmacro outline-current-depth () 1317 "Return nesting depth of visible topic most immediately containing point." 1318 '(save-excursion 1319 (if (outline-back-to-current-heading) 1320 (max 1 1321 (- outline-recent-prefix-end 1322 outline-recent-prefix-beginning 1323 outline-header-subtraction)) 1324 0))) 1325;;;_ > outline-get-current-prefix () 1326(defun outline-get-current-prefix () 1327 "Topic prefix of the current topic." 1328 (save-excursion 1329 (if (outline-goto-prefix) 1330 (outline-recent-prefix)))) 1331;;;_ > outline-get-bullet () 1332(defun outline-get-bullet () 1333 "Return bullet of containing topic (visible or not)." 1334 (save-excursion 1335 (and (outline-goto-prefix) 1336 (outline-recent-bullet)))) 1337;;;_ > outline-current-bullet () 1338(defun outline-current-bullet () 1339 "Return bullet of current (visible) topic heading, or none if none found." 1340 (condition-case err 1341 (save-excursion 1342 (outline-back-to-current-heading) 1343 (buffer-substring (- outline-recent-prefix-end 1) 1344 outline-recent-prefix-end)) 1345 ;; Quick and dirty provision, ostensibly for missing bullet: 1346 (args-out-of-range nil)) 1347 ) 1348;;;_ > outline-get-prefix-bullet (prefix) 1349(defun outline-get-prefix-bullet (prefix) 1350 "Return the bullet of the header prefix string PREFIX." 1351 ;; Doesn't make sense if we're old-style prefixes, but this just 1352 ;; oughtn't be called then, so forget about it... 1353 (if (string-match outline-regexp prefix) 1354 (substring prefix (1- (match-end 0)) (match-end 0)))) 1355 1356;;;_ - Navigation macros 1357;;;_ > outline-next-heading () 1358(defmacro outline-next-heading () 1359 "Move to the heading for the topic \(possibly invisible) before this one. 1360 1361Returns the location of the heading, or nil if none found." 1362 1363 '(if (and (bobp) (not (eobp))) 1364 (forward-char 1)) 1365 1366 '(if (re-search-forward outline-line-boundary-regexp nil 0) 1367 (progn ; Got valid location state - set vars: 1368 (outline-prefix-data 1369 (goto-char (or (match-beginning 2) 1370 outline-recent-prefix-beginning)) 1371 (or (match-end 2) outline-recent-prefix-end))))) 1372;;;_ : outline-this-or-next-heading 1373(defun outline-this-or-next-heading () 1374 "Position cursor on current or next heading." 1375 ;; A throwaway non-macro that is defined after outline-next-heading 1376 ;; and usable by outline-mode. 1377 (if (not (outline-goto-prefix)) (outline-next-heading))) 1378;;;_ > outline-previous-heading () 1379(defmacro outline-previous-heading () 1380 "Move to the prior \(possibly invisible) heading line. 1381 1382Return the location of the beginning of the heading, or nil if not found." 1383 1384 '(if (bobp) 1385 nil 1386 (outline-goto-prefix) 1387 (if 1388 ;; searches are unbounded and return nil if failed: 1389 (or (re-search-backward outline-line-boundary-regexp nil 0) 1390 (looking-at outline-bob-regexp)) 1391 (progn ; Got valid location state - set vars: 1392 (outline-prefix-data 1393 (goto-char (or (match-beginning 2) 1394 outline-recent-prefix-beginning)) 1395 (or (match-end 2) outline-recent-prefix-end)))))) 1396 1397;;;_ - Subtree Charting 1398;;;_ " These routines either produce or assess charts, which are 1399;;; nested lists of the locations of topics within a subtree. 1400;;; 1401;;; Use of charts enables efficient navigation of subtrees, by 1402;;; requiring only a single regexp-search based traversal, to scope 1403;;; out the subtopic locations. The chart then serves as the basis 1404;;; for whatever assessment or adjustment of the subtree that is 1405;;; required, without requiring redundant topic-traversal procedures. 1406 1407;;;_ > outline-chart-subtree (&optional levels orig-depth prev-depth) 1408(defun outline-chart-subtree (&optional levels orig-depth prev-depth) 1409 "Produce a location \"chart\" of subtopics of the containing topic. 1410 1411Optional argument LEVELS specifies the depth \(releative to start 1412depth\) for the chart. Subsequent optional args are not for public 1413use. 1414 1415Charts are used to capture outline structure, so that outline-altering 1416routines need assess the structure only once, and then use the chart 1417for their elaborate manipulations. 1418 1419Topics are entered in the chart so the last one is at the car. 1420The entry for each topic consists of an integer indicating the point 1421at the beginning of the topic. Charts for offspring consists of a 1422list containing, recursively, the charts for the respective subtopics. 1423The chart for a topics' offspring precedes the entry for the topic 1424itself. 1425 1426The other function parameters are for internal recursion, and should 1427not be specified by external callers. ORIG-DEPTH is depth of topic at 1428starting point, and PREV-DEPTH is depth of prior topic." 1429 1430 (let ((original (not orig-depth)) ; 'orig-depth' set only in recursion. 1431 chart curr-depth) 1432 1433 (if original ; Just starting? 1434 ; Register initial settings and 1435 ; position to first offspring: 1436 (progn (setq orig-depth (outline-depth)) 1437 (or prev-depth (setq prev-depth (1+ orig-depth))) 1438 (outline-next-heading))) 1439 1440 ;; Loop over the current levels' siblings. Besides being more 1441 ;; efficient than tail-recursing over a level, it avoids exceeding 1442 ;; the typically quite constrained emacs max-lisp-eval-depth. 1443 ;; Probably would speed things up to implement loop-based stack 1444 ;; operation rather than recursing for lower levels. Bah. 1445 (while (and (not (eobp)) 1446 ; Still within original topic? 1447 (< orig-depth (setq curr-depth (outline-recent-depth))) 1448 (cond ((= prev-depth curr-depth) 1449 ;; Register this one and move on: 1450 (setq chart (cons (point) chart)) 1451 (if (and levels (<= levels 1)) 1452 ;; At depth limit - skip sublevels: 1453 (or (outline-next-sibling curr-depth) 1454 ;; or no more siblings - proceed to 1455 ;; next heading at lesser depth: 1456 (while (and (<= curr-depth 1457 (outline-recent-depth)) 1458 (outline-next-heading)))) 1459 (outline-next-heading))) 1460 1461 ((and (< prev-depth curr-depth) 1462 (or (not levels) 1463 (> levels 0))) 1464 ;; Recurse on deeper level of curr topic: 1465 (setq chart 1466 (cons (outline-chart-subtree (and levels 1467 (1- levels)) 1468 orig-depth 1469 curr-depth) 1470 chart)) 1471 ;; ... then continue with this one. 1472 ) 1473 1474 ;; ... else nil if we've ascended back to prev-depth. 1475 1476 ))) 1477 1478 (if original ; We're at the last sibling on 1479 ; the original level. Position 1480 ; to the end of it: 1481 (progn (and (not (eobp)) (forward-char -1)) 1482 (and (memq (preceding-char) '(?\n ?\^M)) 1483 (memq (aref (buffer-substring (max 1 (- (point) 3)) 1484 (point)) 1485 1) 1486 '(?\n ?\^M)) 1487 (forward-char -1)) 1488 (setq outline-recent-end-of-subtree (point)))) 1489 1490 chart ; (nreverse chart) not necessary, 1491 ; and maybe not preferable. 1492 )) 1493;;;_ > outline-chart-siblings (&optional start end) 1494(defun outline-chart-siblings (&optional start end) 1495 "Produce a list of locations of this and succeeding sibling topics. 1496Effectively a top-level chart of siblings. See 'outline-chart-subtree' 1497for an explanation of charts." 1498 (save-excursion 1499 (if (outline-goto-prefix) 1500 (let ((chart (list (point)))) 1501 (while (outline-next-sibling) 1502 (setq chart (cons (point) chart))) 1503 (if chart (setq chart (nreverse chart))))))) 1504;;;_ > outline-chart-to-reveal (chart depth) 1505(defun outline-chart-to-reveal (chart depth) 1506 1507 "Return a flat list of hidden points in subtree CHART, up to DEPTH. 1508 1509Note that point can be left at any of the points on chart, or at the 1510start point." 1511 1512 (let (result here) 1513 (while (and (or (eq depth t) (> depth 0)) 1514 chart) 1515 (setq here (car chart)) 1516 (if (listp here) 1517 (let ((further (outline-chart-to-reveal here (or (eq depth t) 1518 (1- depth))))) 1519 ;; We're on the start of a subtree - recurse with it, if there's 1520 ;; more depth to go: 1521 (if further (setq result (append further result))) 1522 (setq chart (cdr chart))) 1523 (goto-char here) 1524 (if (= (preceding-char) ?\r) 1525 (setq result (cons here result))) 1526 (setq chart (cdr chart)))) 1527 result)) 1528;;;_ X outline-chart-spec (chart spec &optional exposing) 1529(defun outline-chart-spec (chart spec &optional exposing) 1530 "Not yet \(if ever\) implemented. 1531 1532Produce exposure directives given topic/subtree CHART and an exposure SPEC. 1533 1534Exposure spec indicates the locations to be exposed and the prescribed 1535exposure status. Optional arg EXPOSING is an integer, with 0 1536indicating pending concealment, anything higher indicating depth to 1537which subtopic headers should be exposed, and negative numbers 1538indicating (negative of) the depth to which subtopic headers and 1539bodies should be exposed. 1540 1541The produced list can have two types of entries. Bare numbers 1542indicate points in the buffer where topic headers that should be 1543exposed reside. 1544 1545 - bare negative numbers indicates that the topic starting at the 1546 point which is the negative of the number should be opened, 1547 including their entries. 1548 - bare positive values indicate that this topic header should be 1549 openned. 1550 - Lists signify the beginning and end points of regions that should 1551 be flagged, and the flag to employ. (For concealment: '\(\?r\)', and 1552 exposure:" 1553 (while spec 1554 (cond ((listp spec) 1555 ) 1556 ) 1557 (setq spec (cdr spec))) 1558 ) 1559 1560;;;_ - Within Topic 1561;;;_ > outline-goto-prefix () 1562(defun outline-goto-prefix () 1563 "Put point at beginning of outline prefix for immediately containing topic. 1564 1565Goes to first subsequent topic if none immediately containing. 1566 1567Not sensitive to topic visibility. 1568 1569Returns a the point at the beginning of the prefix, or nil if none." 1570 1571 (let (done) 1572 (while (and (not done) 1573 (re-search-backward "[\n\r]" nil 1)) 1574 (forward-char 1) 1575 (if (looking-at outline-regexp) 1576 (setq done (outline-prefix-data (match-beginning 0) 1577 (match-end 0))) 1578 (forward-char -1))) 1579 (if (bobp) 1580 (cond ((looking-at outline-regexp) 1581 (outline-prefix-data (match-beginning 0)(match-end 0))) 1582 ((outline-next-heading) 1583 (outline-prefix-data (match-beginning 0)(match-end 0))) 1584 (done)) 1585 done))) 1586;;;_ > outline-end-of-prefix () 1587(defun outline-end-of-prefix (&optional ignore-decorations) 1588 "Position cursor at beginning of header text. 1589 1590If optional IGNORE-DECORATIONS is non-nil, put just after bullet, 1591otherwise skip white space between bullet and ensuing text." 1592 1593 (if (not (outline-goto-prefix)) 1594 nil 1595 (let ((match-data (match-data))) 1596 (goto-char (match-end 0)) 1597 (if ignore-decorations 1598 t 1599 (while (looking-at "[0-9]") (forward-char 1)) 1600 (if (and (not (eolp)) (looking-at "\\s-")) (forward-char 1))) 1601 (store-match-data match-data)) 1602 ;; Reestablish where we are: 1603 (outline-current-depth))) 1604;;;_ > outline-current-bullet-pos () 1605(defun outline-current-bullet-pos () 1606 "Return position of current \(visible) topic's bullet." 1607 1608 (if (not (outline-current-depth)) 1609 nil 1610 (1- (match-end 0)))) 1611;;;_ > outline-back-to-current-heading () 1612(defun outline-back-to-current-heading () 1613 "Move to heading line of current topic, or beginning if already on the line." 1614 1615 (beginning-of-line) 1616 (prog1 (or (outline-on-current-heading-p) 1617 (and (re-search-backward (concat "^\\(" outline-regexp "\\)") 1618 nil 1619 'move) 1620 (outline-prefix-data (match-beginning 1)(match-end 1)))) 1621 (if (interactive-p) (outline-end-of-prefix)))) 1622;;;_ > outline-pre-next-preface () 1623(defun outline-pre-next-preface () 1624 "Skip forward to just before the next heading line. 1625 1626Returns that character position." 1627 1628 (if (re-search-forward outline-line-boundary-regexp nil 'move) 1629 (prog1 (goto-char (match-beginning 0)) 1630 (outline-prefix-data (match-beginning 2)(match-end 2))))) 1631;;;_ > outline-end-of-current-subtree () 1632(defun outline-end-of-current-subtree () 1633 "Put point at the end of the last leaf in the currently visible topic." 1634 (interactive) 1635 (outline-back-to-current-heading) 1636 (let ((level (outline-recent-depth))) 1637 (outline-next-heading) 1638 (while (and (not (eobp)) 1639 (> (outline-recent-depth) level)) 1640 (outline-next-heading)) 1641 (and (not (eobp)) (forward-char -1)) 1642 (and (memq (preceding-char) '(?\n ?\^M)) 1643 (memq (aref (buffer-substring (max 1 (- (point) 3)) (point)) 1) 1644 '(?\n ?\^M)) 1645 (forward-char -1)) 1646 (setq outline-recent-end-of-subtree (point)))) 1647;;;_ > outline-beginning-of-current-entry () 1648(defun outline-beginning-of-current-entry () 1649 "When not already there, position point at beginning of current topic's body. 1650 1651If already there, move cursor to bullet for hot-spot operation. 1652\(See outline-mode doc string for details on hot-spot operation.)" 1653 (interactive) 1654 (let ((start-point (point))) 1655 (outline-end-of-prefix) 1656 (if (and (interactive-p) 1657 (= (point) start-point)) 1658 (goto-char (outline-current-bullet-pos))))) 1659;;;_ > outline-end-of-current-entry () 1660(defun outline-end-of-current-entry () 1661 "Position the point at the end of the current topics' entry." 1662 (interactive) 1663 (outline-show-entry) 1664 (prog1 (outline-pre-next-preface) 1665 (if (and (not (bobp))(looking-at "^$")) 1666 (forward-char -1)))) 1667 1668;;;_ - Depth-wise 1669;;;_ > outline-ascend-to-depth (depth) 1670(defun outline-ascend-to-depth (depth) 1671 "Ascend to depth DEPTH, returning depth if successful, nil if not." 1672 (if (and (> depth 0)(<= depth (outline-depth))) 1673 (let ((last-good (point))) 1674 (while (and (< depth (outline-depth)) 1675 (setq last-good (point)) 1676 (outline-beginning-of-level) 1677 (outline-previous-heading))) 1678 (if (= (outline-recent-depth) depth) 1679 (progn (goto-char outline-recent-prefix-beginning) 1680 depth) 1681 (goto-char last-good) 1682 nil)) 1683 (if (interactive-p) (outline-end-of-prefix)))) 1684;;;_ > outline-descend-to-depth (depth) 1685(defun outline-descend-to-depth (depth) 1686 "Descend to depth DEPTH within current topic. 1687 1688Returning depth if successful, nil if not." 1689 (let ((start-point (point)) 1690 (start-depth (outline-depth))) 1691 (while 1692 (and (> (outline-depth) 0) 1693 (not (= depth (outline-recent-depth))) ; ... not there yet 1694 (outline-next-heading) ; ... go further 1695 (< start-depth (outline-recent-depth)))) ; ... still in topic 1696 (if (and (> (outline-depth) 0) 1697 (= (outline-recent-depth) depth)) 1698 depth 1699 (goto-char start-point) 1700 nil)) 1701 ) 1702;;;_ > outline-up-current-level (arg &optional dont-complain) 1703(defun outline-up-current-level (arg &optional dont-complain) 1704 "Move out ARG levels from current visible topic. 1705 1706Positions on heading line of containing topic. Error if unable to 1707ascend that far, or nil if unable to ascend but optional arg 1708DONT-COMPLAIN is non-nil." 1709 (interactive "p") 1710 (outline-back-to-current-heading) 1711 (let ((present-level (outline-recent-depth)) 1712 (last-good (point)) 1713 failed 1714 return) 1715 ;; Loop for iterating arg: 1716 (while (and (> (outline-recent-depth) 1) 1717 (> arg 0) 1718 (not (bobp)) 1719 (not failed)) 1720 (setq last-good (point)) 1721 ;; Loop for going back over current or greater depth: 1722 (while (and (not (< (outline-recent-depth) present-level)) 1723 (or (outline-previous-visible-heading 1) 1724 (not (setq failed present-level))))) 1725 (setq present-level (outline-current-depth)) 1726 (setq arg (- arg 1))) 1727 (if (or failed 1728 (> arg 0)) 1729 (progn (goto-char last-good) 1730 (if (interactive-p) (outline-end-of-prefix)) 1731 (if (not dont-complain) 1732 (error "Can't ascend past outermost level.") 1733 (if (interactive-p) (outline-end-of-prefix)) 1734 nil)) 1735 (if (interactive-p) (outline-end-of-prefix)) 1736 outline-recent-prefix-beginning))) 1737 1738;;;_ - Linear 1739;;;_ > outline-next-sibling (&optional depth backward) 1740(defun outline-next-sibling (&optional depth backward) 1741 "Like outline-forward-current-level, but respects invisible topics. 1742 1743Traverse at optional DEPTH, or current depth if none specified. 1744 1745Go backward if optional arg BACKWARD is non-nil. 1746 1747Return depth if successful, nil otherwise." 1748 1749 (if (and backward (bobp)) 1750 nil 1751 (let ((start-depth (or depth (outline-depth))) 1752 (start-point (point)) 1753 last-depth) 1754 (while (and (not (if backward (bobp) (eobp))) 1755 (if backward (outline-previous-heading) 1756 (outline-next-heading)) 1757 (> (setq last-depth (outline-recent-depth)) start-depth))) 1758 (if (and (not (eobp)) 1759 (and (> (or last-depth (outline-depth)) 0) 1760 (= (outline-recent-depth) start-depth))) 1761 outline-recent-prefix-beginning 1762 (goto-char start-point) 1763 (if depth (outline-depth) start-depth) 1764 nil)))) 1765;;;_ > outline-previous-sibling (&optional depth backward) 1766(defun outline-previous-sibling (&optional depth backward) 1767 "Like outline-forward-current-level,but backwards & respect invisible topics. 1768 1769Optional DEPTH specifies depth to traverse, default current depth. 1770 1771Optional BACKWARD reverses direction. 1772 1773Return depth if successful, nil otherwise." 1774 (outline-next-sibling depth (not backward)) 1775 ) 1776;;;_ > outline-snug-back () 1777(defun outline-snug-back () 1778 "Position cursor at end of previous topic 1779 1780Presumes point is at the start of a topic prefix." 1781 (if (or (bobp) (eobp)) 1782 nil 1783 (forward-char -1)) 1784 (if (or (bobp) (not (memq (preceding-char) '(?\n ?\^M)))) 1785 nil 1786 (forward-char -1) 1787 (if (or (bobp) (not (memq (preceding-char) '(?\n ?\^M)))) 1788 (forward-char -1))) 1789 (point)) 1790;;;_ > outline-beginning-of-level () 1791(defun outline-beginning-of-level () 1792 "Go back to the first sibling at this level, visible or not." 1793 (outline-end-of-level 'backward)) 1794;;;_ > outline-end-of-level (&optional backward) 1795(defun outline-end-of-level (&optional backward) 1796 "Go to the last sibling at this level, visible or not." 1797 1798 (let ((depth (outline-depth))) 1799 (while (outline-previous-sibling depth nil)) 1800 (prog1 (outline-recent-depth) 1801 (if (interactive-p) (outline-end-of-prefix))))) 1802;;;_ > outline-next-visible-heading (arg) 1803(defun outline-next-visible-heading (arg) 1804 "Move to the next ARG'th visible heading line, backward if arg is negative. 1805 1806Move as far as possible in indicated direction \(beginning or end of 1807buffer\) if headings are exhausted." 1808 1809 (interactive "p") 1810 (let* ((backward (if (< arg 0) (setq arg (* -1 arg)))) 1811 (step (if backward -1 1)) 1812 (start-point (point)) 1813 prev got) 1814 1815 (while (> arg 0) ; limit condition 1816 (while (and (not (if backward (bobp)(eobp))) ; boundary condition 1817 ;; Move, skipping over all those concealed lines: 1818 (< -1 (forward-line step)) 1819 (not (setq got (looking-at outline-regexp))))) 1820 ;; Register this got, it may be the last: 1821 (if got (setq prev got)) 1822 (setq arg (1- arg))) 1823 (cond (got ; Last move was to a prefix: 1824 (outline-prefix-data (match-beginning 0) (match-end 0)) 1825 (outline-end-of-prefix)) 1826 (prev ; Last move wasn't, but prev was: 1827 (outline-prefix-data (match-beginning 0) (match-end 0))) 1828 ((not backward) (end-of-line) nil)))) 1829;;;_ > outline-previous-visible-heading (arg) 1830(defun outline-previous-visible-heading (arg) 1831 "Move to the previous heading line. 1832 1833With argument, repeats or can move forward if negative. 1834A heading line is one that starts with a `*' (or that outline-regexp 1835matches)." 1836 (interactive "p") 1837 (outline-next-visible-heading (- arg))) 1838;;;_ > outline-forward-current-level (arg) 1839(defun outline-forward-current-level (arg) 1840 "Position point at the next heading of the same level. 1841 1842Takes optional repeat-count, goes backward if count is negative. 1843 1844Returns resulting position, else nil if none found." 1845 (interactive "p") 1846 (let ((start-depth (outline-current-depth)) 1847 (start-point (point)) 1848 (start-arg arg) 1849 (backward (> 0 arg)) 1850 last-depth 1851 (last-good (point)) 1852 at-boundary) 1853 (if (= 0 start-depth) 1854 (error "No siblings, not in a topic...")) 1855 (if backward (setq arg (* -1 arg))) 1856 (while (not (or (zerop arg) 1857 at-boundary)) 1858 (while (and (not (if backward (bobp) (eobp))) 1859 (if backward (outline-previous-visible-heading 1) 1860 (outline-next-visible-heading 1)) 1861 (> (setq last-depth (outline-recent-depth)) start-depth))) 1862 (if (and last-depth (= last-depth start-depth) 1863 (not (if backward (bobp) (eobp)))) 1864 (setq last-good (point) 1865 arg (1- arg)) 1866 (setq at-boundary t))) 1867 (if (and (not (eobp)) 1868 (= arg 0) 1869 (and (> (or last-depth (outline-depth)) 0) 1870 (= (outline-recent-depth) start-depth))) 1871 outline-recent-prefix-beginning 1872 (goto-char last-good) 1873 (if (not (interactive-p)) 1874 nil 1875 (outline-end-of-prefix) 1876 (error "Hit %s level %d topic, traversed %d of %d requested." 1877 (if backward "first" "last") 1878 (outline-recent-depth) 1879 (- (abs start-arg) arg) 1880 (abs start-arg)))))) 1881;;;_ > outline-backward-current-level (arg) 1882(defun outline-backward-current-level (arg) 1883 "Inverse of `outline-forward-current-level'." 1884 (interactive "p") 1885 (if (interactive-p) 1886 (let ((current-prefix-arg (* -1 arg))) 1887 (call-interactively 'outline-forward-current-level)) 1888 (outline-forward-current-level (* -1 arg)))) 1889 1890;;;_ #5 Alteration 1891 1892;;;_ - Fundamental 1893;;;_ > outline-before-change-protect (beg end) 1894(defun outline-before-change-protect (beg end) 1895 "Outline before-change hook, regulates changes to concealed text. 1896 1897Reveal concealed text that would be changed by current command, and 1898offer user choice to commit or forego the change. Unchanged text is 1899reconcealed. User has option to have changed text reconcealed. 1900 1901Undo commands are specially treated - the user is not prompted for 1902choice, the undoes are always committed (based on presumption that the 1903things being undone were already subject to this regulation routine), 1904and undoes always leave the changed stuff exposed. 1905 1906Changes to concealed regions are ignored while file is being written. 1907\(This is for the sake of functions that do change the file during 1908writes, like crypt and zip modes.) 1909 1910Locally bound in outline buffers to 'before-change-function', which 1911in emacs 19 is run before any change to the buffer. (Has no effect 1912in Emacs 18, which doesn't support before-change-function.) 1913 1914Any functions which set ['this-command' to 'undo', or which set] 1915'outline-override-protect' non-nil (as does, eg, outline-flag-chars) 1916are exempt from this restriction." 1917 (if (and (outline-mode-p) 1918 ; outline-override-protect 1919 ; set by functions that know what 1920 ; they're doing, eg outline internals: 1921 (not outline-override-protect) 1922 (not outline-during-write-cue) 1923 (save-match-data ; Preserve operation position state. 1924 ; Both beginning and end chars must 1925 ; be exposed: 1926 (save-excursion (if (memq this-command '(newline open-line)) 1927 ;; Compensate for stupid emacs {new, 1928 ;; open-}line display optimization: 1929 (setq beg (1+ beg) 1930 end (1+ end))) 1931 (goto-char beg) 1932 (or (outline-hidden-p) 1933 (and (not (= beg end)) 1934 (goto-char end) 1935 (outline-hidden-p)))))) 1936 (save-match-data 1937 (if (equal this-command 'undo) 1938 ;; Allow undo without inhibition. 1939 ;; - Undoing new and open-line hits stupid emacs redisplay 1940 ;; optimization (em 19 cmds.c, ~ line 200). 1941 ;; - Presumably, undoing what was properly protected when 1942 ;; done. 1943 ;; - Undo may be users' only recourse in protection faults. 1944 ;; So, expose what getting changed: 1945 (progn (message "Undo! - exposing concealed target...") 1946 (if (outline-hidden-p) 1947 (outline-show-children)) 1948 (message "Undo!")) 1949 (let (response 1950 (rehide-completely (save-excursion (outline-goto-prefix) 1951 (outline-hidden-p))) 1952 rehide-place) 1953 1954 (save-excursion 1955 (if (condition-case err 1956 ;; Condition case to catch keyboard quits during reads. 1957 (progn 1958 ; Give them a peek where 1959 (save-excursion 1960 (if (eolp) (setq rehide-place 1961 (outline-goto-prefix))) 1962 (outline-show-entry)) 1963 ; Present the message, but... 1964 ; leave the cursor at the location 1965 ; until they respond: 1966 ; Then interpret the response: 1967 (while 1968 (progn 1969 (message (concat "Change inside concealed" 1970 " region - do it? " 1971 "(n or 'y'/'r'eclose)")) 1972 (setq response (read-char)) 1973 (not 1974 (cond ((memq response '(?r ?R)) 1975 (setq response 'reclose)) 1976 ((memq response '(?y ?Y ? )) 1977 (setq response t)) 1978 ((memq response '(?n ?N 127)) 1979 (setq response nil) 1980 t) 1981 ((eq response ??) 1982 (message 1983 "'r' means 'yes, then reclose") 1984 nil) 1985 (t (message "Please answer y, n, or r") 1986 (sit-for 1) 1987 nil))))) 1988 response) 1989 (quit nil)) 1990 ; Continue: 1991 (if (eq response 'reclose) 1992 (save-excursion 1993 (if rehide-place (goto-char rehide-place)) 1994 (if rehide-completely 1995 (outline-hide-current-entry-completely) 1996 (outline-hide-current-entry))) 1997 (if (outline-ascend-to-depth (1- (outline-recent-depth))) 1998 (outline-show-children) 1999 (outline-show-to-offshoot))) 2000 ; Prevent: 2001 (if rehide-completely 2002 (save-excursion 2003 (if rehide-place (goto-char rehide-place)) 2004 (outline-hide-current-entry-completely)) 2005 (outline-hide-current-entry)) 2006 (error (concat 2007 "Change within concealed region prevented."))))))) 2008 ) ; if 2009 ) ; defun 2010;;;_ = outline-post-goto-bullet 2011(defvar outline-post-goto-bullet nil 2012 "Outline internal var, for `outline-pre-command-business' hot-spot operation. 2013 2014When set, tells post-processing to reposition on topic bullet, and 2015then unset it. Set by outline-pre-command-business when implementing 2016hot-spot operation, where literal characters typed over a topic bullet 2017are mapped to the command of the corresponding control-key on the 2018outline-mode-map.") 2019(make-variable-buffer-local 'outline-post-goto-bullet) 2020;;;_ > outline-post-command-business () 2021(defun outline-post-command-business () 2022 "Outline post-command-hook function. 2023 2024- Null outline-override-protect, so it's not left open. 2025 2026- Implement (and clear) outline-post-goto-bullet, for hot-spot 2027 outline commands. 2028 2029- Massages buffer-undo-list so successive, standard character self-inserts are 2030 aggregated. This kludge compensates for lack of undo bunching when 2031 before-change-function is used." 2032 2033 ; Apply any external change func: 2034 (if (not (outline-mode-p)) ; In outline-mode. 2035 nil 2036 (setq outline-override-protect nil) 2037 (if outline-during-write-cue 2038 ;; Was used by outline-before-change-protect, done with it now: 2039 (setq outline-during-write-cue nil)) 2040 ;; Undo bunching business: 2041 (if (and (listp buffer-undo-list) ; Undo history being kept. 2042 (equal this-command 'self-insert-command) 2043 (equal last-command 'self-insert-command)) 2044 (let* ((prev-stuff (cdr buffer-undo-list)) 2045 (before-prev-stuff (cdr (cdr prev-stuff))) 2046 cur-cell cur-from cur-to 2047 prev-cell prev-from prev-to) 2048 (if (and before-prev-stuff ; Goes back far enough to bother, 2049 (not (car prev-stuff)) ; and break before current, 2050 (not (car before-prev-stuff)) ; !and break before prev! 2051 (setq prev-cell (car (cdr prev-stuff))) ; contents now, 2052 (setq cur-cell (car buffer-undo-list)) ; contents prev. 2053 2054 ;; cur contents denote a single char insertion: 2055 (numberp (setq cur-from (car cur-cell))) 2056 (numberp (setq cur-to (cdr cur-cell))) 2057 (= 1 (- cur-to cur-from)) 2058 2059 ;; prev contents denote fewer than aggregate-limit 2060 ;; insertions: 2061 (numberp (setq prev-from (car prev-cell))) 2062 (numberp (setq prev-to (cdr prev-cell))) 2063 ; Below threshold: 2064 (> outline-undo-aggregation (- prev-to prev-from))) 2065 (setq buffer-undo-list 2066 (cons (cons prev-from cur-to) 2067 (cdr (cdr (cdr buffer-undo-list)))))))) 2068 ;; Implement -post-goto-bullet, if set: (must be after undo business) 2069 (if (and outline-post-goto-bullet 2070 (outline-current-bullet-pos)) 2071 (progn (goto-char (outline-current-bullet-pos)) 2072 (setq outline-post-goto-bullet nil))) 2073 )) 2074;;;_ > outline-pre-command-business () 2075(defun outline-pre-command-business () 2076 "Outline pre-command-hook function for outline buffers. 2077 2078Implements special behavior when cursor is on bullet char. 2079 2080Self-insert characters are reinterpreted control-character references 2081into the outline-mode-map. The outline-mode post-command hook will 2082position a cursor that has moved as a result of such reinterpretation, 2083on the destination topic's bullet, when the cursor wound up in the 2084 2085The upshot is that you can get easy, single (unmodified) key outline 2086maneuvering and general operations by positioning the cursor on the 2087bullet char, and it continues until you deliberately some non-outline 2088motion command to relocate the cursor off of a bullet char." 2089 2090 (if (and (boundp 'outline-mode) 2091 outline-mode 2092 (eq this-command 'self-insert-command) 2093 (eq (point)(outline-current-bullet-pos))) 2094 2095 (let* ((this-key-num (if (numberp last-command-event) 2096 last-command-event)) 2097 mapped-binding) 2098 2099 ; Map upper-register literals 2100 ; to lower register: 2101 (if (<= 96 this-key-num) 2102 (setq this-key-num (- this-key-num 32))) 2103 ; Check if we have a literal: 2104 (if (and (<= 64 this-key-num) 2105 (>= 96 this-key-num)) 2106 (setq mapped-binding 2107 (lookup-key 'outline-mode-map 2108 (concat outline-command-prefix 2109 (char-to-string (- this-key-num 64)))))) 2110 (if mapped-binding 2111 (setq outline-post-goto-bullet t 2112 this-command mapped-binding))))) 2113;;;_ > outline-find-file-hook () 2114(defun outline-find-file-hook () 2115 "Activate outline-mode when `outline-auto-activation' & `outline-layout' are non-nil. 2116 2117See `outline-init' for setup instructions." 2118 (if (and outline-auto-activation 2119 (not (outline-mode-p)) 2120 outline-layout) 2121 (outline-mode t))) 2122;;;_ : Establish the hooks 2123(add-hook 'post-command-hook 'outline-post-command-business) 2124(add-hook 'pre-command-hook 'outline-pre-command-business) 2125 2126;;;_ - Topic Format Assessment 2127;;;_ > outline-solicit-alternate-bullet (depth &optional current-bullet) 2128(defun outline-solicit-alternate-bullet (depth &optional current-bullet) 2129 2130 "Prompt for and return a bullet char as an alternative to the current one. 2131 2132Offer one suitable for current depth DEPTH as default." 2133 2134 (let* ((default-bullet (or current-bullet 2135 (outline-bullet-for-depth depth))) 2136 (sans-escapes (regexp-sans-escapes outline-bullets-string)) 2137 (choice (solicit-char-in-string 2138 (format "Select bullet: %s ('%s' default): " 2139 sans-escapes 2140 default-bullet) 2141 sans-escapes 2142 t))) 2143 (if (string= choice "") default-bullet choice)) 2144 ) 2145;;;_ > outline-sibling-index (&optional depth) 2146(defun outline-sibling-index (&optional depth) 2147 "Item number of this prospective topic among its siblings. 2148 2149If optional arg depth is greater than current depth, then we're 2150opening a new level, and return 0. 2151 2152If less than this depth, ascend to that depth and count..." 2153 2154 (save-excursion 2155 (cond ((and depth (<= depth 0) 0)) 2156 ((or (not depth) (= depth (outline-depth))) 2157 (let ((index 1)) 2158 (while (outline-previous-sibling (outline-recent-depth) nil) 2159 (setq index (1+ index))) 2160 index)) 2161 ((< depth (outline-recent-depth)) 2162 (outline-ascend-to-depth depth) 2163 (outline-sibling-index)) 2164 (0)))) 2165;;;_ > outline-distinctive-bullet (bullet) 2166(defun outline-distinctive-bullet (bullet) 2167 "True if bullet is one of those on outline-distinctive-bullets-string." 2168 (string-match (regexp-quote bullet) outline-distinctive-bullets-string)) 2169;;;_ > outline-numbered-type-prefix (&optional prefix) 2170(defun outline-numbered-type-prefix (&optional prefix) 2171 "True if current header prefix bullet is numbered bullet." 2172 (and outline-numbered-bullet 2173 (string= outline-numbered-bullet 2174 (if prefix 2175 (outline-get-prefix-bullet prefix) 2176 (outline-get-bullet))))) 2177;;;_ > outline-bullet-for-depth (&optional depth) 2178(defun outline-bullet-for-depth (&optional depth) 2179 "Return outline topic bullet suited to optional DEPTH, or current depth." 2180 ;; Find bullet in plain-bullets-string modulo DEPTH. 2181 (if outline-stylish-prefixes 2182 (char-to-string (aref outline-plain-bullets-string 2183 (% (max 0 (- depth 2)) 2184 outline-plain-bullets-string-len))) 2185 outline-primary-bullet) 2186 ) 2187 2188;;;_ - Topic Production 2189;;;_ > outline-make-topic-prefix (&optional prior-bullet 2190(defun outline-make-topic-prefix (&optional prior-bullet 2191 new 2192 depth 2193 solicit 2194 number-control 2195 index) 2196 ;; Depth null means use current depth, non-null means we're either 2197 ;; opening a new topic after current topic, lower or higher, or we're 2198 ;; changing level of current topic. 2199 ;; Solicit dominates specified bullet-char. 2200;;;_ . Doc string: 2201 "Generate a topic prefix suitable for optional arg DEPTH, or current depth. 2202 2203All the arguments are optional. 2204 2205PRIOR-BULLET indicates the bullet of the prefix being changed, or 2206nil if none. This bullet may be preserved (other options 2207notwithstanding) if it is on the outline-distinctive-bullets-string, 2208for instance. 2209 2210Second arg NEW indicates that a new topic is being opened after the 2211topic at point, if non-nil. Default bullet for new topics, eg, may 2212be set (contingent to other args) to numbered bullets if previous 2213sibling is one. The implication otherwise is that the current topic 2214is being adjusted - shifted or rebulleted - and we don't consider 2215bullet or previous sibling. 2216 2217Third arg DEPTH forces the topic prefix to that depth, regardless of 2218the current topics' depth. 2219 2220Fourth arg SOLICIT non-nil provokes solicitation from the user of a 2221choice among the valid bullets. (This overrides other all the 2222options, including, eg, a distinctive PRIOR-BULLET.) 2223 2224Fifth arg, NUMBER-CONTROL, matters only if 'outline-numbered-bullet' 2225is non-nil *and* soliciting was not explicitly invoked. Then 2226NUMBER-CONTROL non-nil forces prefix to either numbered or 2227denumbered format, depending on the value of the sixth arg, INDEX. 2228 2229\(Note that NUMBER-CONTROL does *not* apply to level 1 topics. Sorry...) 2230 2231If NUMBER-CONTROL is non-nil and sixth arg INDEX is non-nil then 2232the prefix of the topic is forced to be numbered. Non-nil 2233NUMBER-CONTROL and nil INDEX forces non-numbered format on the 2234bullet. Non-nil NUMBER-CONTROL and non-nil, non-number INDEX means 2235that the index for the numbered prefix will be derived, by counting 2236siblings back to start of level. If INDEX is a number, then that 2237number is used as the index for the numbered prefix (allowing, eg, 2238sequential renumbering to not requre this function counting back the 2239index for each successive sibling)." 2240;;;_ . Code: 2241 ;; The options are ordered in likely frequence of use, most common 2242 ;; highest, least lowest. Ie, more likely to be doing prefix 2243 ;; adjustments than soliciting, and yet more than numbering. 2244 ;; Current prefix is least dominant, but most likely to be commonly 2245 ;; specified... 2246 2247 (let* (body 2248 numbering 2249 denumbering 2250 (depth (or depth (outline-depth))) 2251 (header-lead outline-header-prefix) 2252 (bullet-char 2253 2254 ;; Getting value for bullet char is practically the whole job: 2255 2256 (cond 2257 ; Simplest situation - level 1: 2258 ((<= depth 1) (setq header-lead "") outline-primary-bullet) 2259 ; Simple, too: all asterisks: 2260 (outline-old-style-prefixes 2261 ;; Cheat - make body the whole thing, null out header-lead and 2262 ;; bullet-char: 2263 (setq body (make-string depth 2264 (string-to-char outline-primary-bullet))) 2265 (setq header-lead "") 2266 "") 2267 2268 ;; (Neither level 1 nor old-style, so we're space padding. 2269 ;; Sneak it in the condition of the next case, whatever it is.) 2270 2271 ;; Solicitation overrides numbering and other cases: 2272 ((progn (setq body (make-string (- depth 2) ?\ )) 2273 ;; The actual condition: 2274 solicit) 2275 (let* ((got (outline-solicit-alternate-bullet depth))) 2276 ;; Gotta check whether we're numbering and got a numbered bullet: 2277 (setq numbering (and outline-numbered-bullet 2278 (not (and number-control (not index))) 2279 (string= got outline-numbered-bullet))) 2280 ;; Now return what we got, regardless: 2281 got)) 2282 2283 ;; Numbering invoked through args: 2284 ((and outline-numbered-bullet number-control) 2285 (if (setq numbering (not (setq denumbering (not index)))) 2286 outline-numbered-bullet 2287 (if (and prior-bullet 2288 (not (string= outline-numbered-bullet 2289 prior-bullet))) 2290 prior-bullet 2291 (outline-bullet-for-depth depth)))) 2292 2293 ;;; Neither soliciting nor controlled numbering ;;; 2294 ;;; (may be controlled denumbering, tho) ;;; 2295 2296 ;; Check wrt previous sibling: 2297 ((and new ; only check for new prefixes 2298 (<= depth (outline-depth)) 2299 outline-numbered-bullet ; ... & numbering enabled 2300 (not denumbering) 2301 (let ((sibling-bullet 2302 (save-excursion 2303 ;; Locate correct sibling: 2304 (or (>= depth (outline-depth)) 2305 (outline-ascend-to-depth depth)) 2306 (outline-get-bullet)))) 2307 (if (and sibling-bullet 2308 (string= outline-numbered-bullet sibling-bullet)) 2309 (setq numbering sibling-bullet))))) 2310 2311 ;; Distinctive prior bullet? 2312 ((and prior-bullet 2313 (outline-distinctive-bullet prior-bullet) 2314 ;; Either non-numbered: 2315 (or (not (and outline-numbered-bullet 2316 (string= prior-bullet outline-numbered-bullet))) 2317 ;; or numbered, and not denumbering: 2318 (setq numbering (not denumbering))) 2319 ;; Here 'tis: 2320 prior-bullet)) 2321 2322 ;; Else, standard bullet per depth: 2323 ((outline-bullet-for-depth depth))))) 2324 2325 (concat header-lead 2326 body 2327 bullet-char 2328 (if numbering 2329 (format "%d" (cond ((and index (numberp index)) index) 2330 (new (1+ (outline-sibling-index depth))) 2331 ((outline-sibling-index)))))) 2332 ) 2333 ) 2334;;;_ > outline-open-topic (relative-depth &optional before) 2335(defun outline-open-topic (relative-depth &optional before) 2336 "Open a new topic at depth DEPTH. 2337 2338New topic is situated after current one, unless optional flag BEFORE 2339is non-nil, or unless current line is complete empty (not even 2340whitespace), in which case open is done on current line. 2341 2342Nuances: 2343 2344- Creation of new topics is with respect to the visible topic 2345 containing the cursor, regardless of intervening concealed ones. 2346 2347- New headers are generally created after/before the body of a 2348 topic. However, they are created right at cursor location if the 2349 cursor is on a blank line, even if that breaks the current topic 2350 body. This is intentional, to provide a simple means for 2351 deliberately dividing topic bodies. 2352 2353- Double spacing of topic lists is preserved. Also, the first 2354 level two topic is created double-spaced (and so would be 2355 subsequent siblings, if that's left intact). Otherwise, 2356 single-spacing is used. 2357 2358- Creation of sibling or nested topics is with respect to the topic 2359 you're starting from, even when creating backwards. This way you 2360 can easily create a sibling in front of the current topic without 2361 having to go to its preceeding sibling, and then open forward 2362 from there." 2363 2364 (let* ((depth (+ (outline-current-depth) relative-depth)) 2365 (opening-on-blank (if (looking-at "^\$") 2366 (not (setq before nil)))) 2367 opening-numbered ; Will get while computing ref-topic, below 2368 ref-depth ; Will get while computing ref-topic, next 2369 (ref-topic (save-excursion 2370 (cond ((< relative-depth 0) 2371 (outline-ascend-to-depth depth)) 2372 ((>= relative-depth 1) nil) 2373 (t (outline-back-to-current-heading))) 2374 (setq ref-depth (outline-recent-depth)) 2375 (setq opening-numbered 2376 (save-excursion 2377 (and outline-numbered-bullet 2378 (or (<= relative-depth 0) 2379 (outline-descend-to-depth depth)) 2380 (if (outline-numbered-type-prefix) 2381 outline-numbered-bullet)))) 2382 (point))) 2383 dbl-space 2384 doing-beginning) 2385 2386 (if (not opening-on-blank) 2387 ; Positioning and vertical 2388 ; padding - only if not 2389 ; opening-on-blank: 2390 (progn 2391 (goto-char ref-topic) 2392 (setq dbl-space ; Determine double space action: 2393 (or (and (<= relative-depth 0) ; not descending; 2394 (save-excursion 2395 ;; at b-o-b or preceeded by a blank line? 2396 (or (> 0 (forward-line -1)) 2397 (looking-at "^\\s-*$") 2398 (bobp))) 2399 (save-excursion 2400 ;; succeeded by a blank line? 2401 (outline-end-of-current-subtree) 2402 (bolp))) 2403 (and (= ref-depth 1) 2404 (or before 2405 (= depth 1) 2406 (save-excursion 2407 ;; Don't already have following 2408 ;; vertical padding: 2409 (not (outline-pre-next-preface))))))) 2410 2411 ; Position to prior heading, 2412 ; if inserting backwards, and 2413 ; not going outwards: 2414 (if (and before (>= relative-depth 0)) 2415 (progn (outline-back-to-current-heading) 2416 (setq doing-beginning (bobp)) 2417 (if (not (bobp)) 2418 (outline-previous-heading))) 2419 (if (and before (bobp)) 2420 (outline-unprotected (open-line 1)))) 2421 2422 (if (<= relative-depth 0) 2423 ;; Not going inwards, don't snug up: 2424 (if doing-beginning 2425 (outline-unprotected (open-line (if dbl-space 2 1))) 2426 (if before 2427 (progn (end-of-line) 2428 (outline-pre-next-preface) 2429 (while (= ?\r (following-char)) 2430 (forward-char 1)) 2431 (if (not (looking-at "^$")) 2432 (outline-unprotected (open-line 1)))) 2433 (outline-end-of-current-subtree))) 2434 ;; Going inwards - double-space if first offspring is, 2435 ;; otherwise snug up. 2436 (end-of-line) ; So we skip any concealed progeny. 2437 (outline-pre-next-preface) 2438 (if (bolp) 2439 ;; Blank lines between current header body and next 2440 ;; header - get to last substantive (non-white-space) 2441 ;; line in body: 2442 (re-search-backward "[^ \t\n]" nil t)) 2443 (if (save-excursion 2444 (outline-next-heading) 2445 (if (> (outline-recent-depth) ref-depth) 2446 ;; This is an offspring. 2447 (progn (forward-line -1) 2448 (looking-at "^\\s-*$")))) 2449 (progn (forward-line 1) 2450 (outline-unprotected (open-line 1)))) 2451 (end-of-line)) 2452 ;;(if doing-beginning (goto-char doing-beginning)) 2453 (if (not (bobp)) 2454 (progn (if (and (not (> depth ref-depth)) 2455 (not before)) 2456 (outline-unprotected (open-line 1)) 2457 (if (> depth ref-depth) 2458 (outline-unprotected (newline 1)) 2459 (if dbl-space 2460 (outline-unprotected (open-line 1)) 2461 (if (not before) 2462 (outline-unprotected (newline 1)))))) 2463 (if dbl-space 2464 (outline-unprotected (newline 1))) 2465 (if (and (not (eobp)) 2466 (not (bolp))) 2467 (forward-char 1)))) 2468 )) 2469 (insert-string (concat (outline-make-topic-prefix opening-numbered 2470 t 2471 depth) 2472 " ")) 2473 2474 ;;(if doing-beginning (save-excursion (newline (if dbl-space 2 1)))) 2475 2476 2477 (outline-rebullet-heading nil ;;; solicit 2478 depth ;;; depth 2479 nil ;;; number-control 2480 nil ;;; index 2481 t) (end-of-line) 2482 ) 2483 ) 2484;;;_ . open-topic contingencies 2485;;;_ ; base topic - one from which open was issued 2486;;;_ , beginning char 2487;;;_ , amount of space before will be used, unless openning in place 2488;;;_ , end char will be used, unless opening before (and it still may) 2489;;;_ ; absolute depth of new topic 2490;;;_ ! insert in place - overrides most stuff 2491;;;_ ; relative depth of new re base 2492;;;_ ; before or after base topic 2493;;;_ ; spacing around topic, if any, prior to new topic and at same depth 2494;;;_ ; buffer boundaries - special provisions for beginning and end ob 2495;;;_ ; level 1 topics have special provisions also - double space. 2496;;;_ ; location of new topic 2497;;;_ . 2498;;;_ > outline-open-subtopic (arg) 2499(defun outline-open-subtopic (arg) 2500 "Open new topic header at deeper level than the current one. 2501 2502Negative universal arg means to open deeper, but place the new topic 2503prior to the current one." 2504 (interactive "p") 2505 (outline-open-topic 1 (> 0 arg))) 2506;;;_ > outline-open-sibtopic (arg) 2507(defun outline-open-sibtopic (arg) 2508 "Open new topic header at same level as the current one. 2509 2510Negative universal arg means to place the new topic prior to the current 2511one." 2512 (interactive "p") 2513 (outline-open-topic 0 (> 0 arg))) 2514;;;_ > outline-open-supertopic (arg) 2515(defun outline-open-supertopic (arg) 2516 "Open new topic header at shallower level than the current one. 2517 2518Negative universal arg means to open shallower, but place the new 2519topic prior to the current one." 2520 2521 (interactive "p") 2522 (outline-open-topic -1 (> 0 arg))) 2523 2524;;;_ - Outline Alteration 2525;;;_ : Topic Modification 2526;;;_ = outline-former-auto-filler 2527(defvar outline-former-auto-filler nil 2528 "Name of modal fill function being wrapped by outline-auto-fill.") 2529;;;_ > outline-auto-fill () 2530(defun outline-auto-fill () 2531 "Outline-mode autofill function. 2532 2533Maintains outline hanging topic indentation if 2534`outline-use-hanging-indents' is set." 2535 (let ((fill-prefix (if outline-use-hanging-indents 2536 ;; Check for topic header indentation: 2537 (save-excursion 2538 (beginning-of-line) 2539 (if (looking-at outline-regexp) 2540 ;; ... construct indentation to account for 2541 ;; length of topic prefix: 2542 (make-string (progn (outline-end-of-prefix) 2543 (current-column)) 2544 ?\ )))))) 2545 (if (or outline-former-auto-filler outline-use-hanging-indents) 2546 (do-auto-fill)))) 2547;;;_ > outline-reindent-body (old-depth new-depth &optional number) 2548(defun outline-reindent-body (old-depth new-depth &optional number) 2549 "Reindent body lines which were indented at old-depth to new-depth. 2550 2551Optional arg NUMBER indicates numbering is being added, and it must 2552be accomodated. 2553 2554Note that refill of indented paragraphs is not done." 2555 2556 (save-excursion 2557 (outline-end-of-prefix) 2558 (let* ((new-margin (current-column)) 2559 excess old-indent-begin old-indent-end 2560 curr-ind 2561 ;; We want the column where the header-prefix text started 2562 ;; *before* the prefix was changed, so we infer it relative 2563 ;; to the new margin and the shift in depth: 2564 (old-margin (+ old-depth (- new-margin new-depth)))) 2565 2566 ;; Process lines up to (but excluding) next topic header: 2567 (outline-unprotected 2568 (save-match-data 2569 (while 2570 (and (re-search-forward "[\n\r]\\(\\s-*\\)" 2571 nil 2572 t) 2573 ;; Register the indent data, before we reset the 2574 ;; match data with a subsequent 'looking-at': 2575 (setq old-indent-begin (match-beginning 1) 2576 old-indent-end (match-end 1)) 2577 (not (looking-at outline-regexp))) 2578 (if (> 0 (setq excess (- (current-column) 2579 old-margin))) 2580 ;; Text starts left of old margin - don't adjust: 2581 nil 2582 ;; Text was hanging at or right of old left margin - 2583 ;; reindent it, preserving its existing indentation 2584 ;; beyond the old margin: 2585 (delete-region old-indent-begin old-indent-end) 2586 (indent-to (+ new-margin excess))))))))) 2587;;;_ > outline-rebullet-current-heading (arg) 2588(defun outline-rebullet-current-heading (arg) 2589 "Like non-interactive version 'outline-rebullet-heading'. 2590 2591But \(only\) affects visible heading containing point. 2592 2593With repeat count, solicit for bullet." 2594 (interactive "P") 2595 (save-excursion (outline-back-to-current-heading) 2596 (outline-end-of-prefix) 2597 (outline-rebullet-heading (not arg) ;;; solicit 2598 nil ;;; depth 2599 nil ;;; number-control 2600 nil ;;; index 2601 t) ;;; do-successors 2602 ) 2603 ) 2604;;;_ > outline-rebullet-heading (&optional solicit ...) 2605(defun outline-rebullet-heading (&optional solicit 2606 new-depth 2607 number-control 2608 index 2609 do-successors) 2610 2611 "Adjust bullet of current topic prefix. 2612 2613All args are optional. 2614 2615If SOLICIT is non-nil then the choice of bullet is solicited from 2616user. Otherwise the distinctiveness of the bullet or the topic 2617depth determines it. 2618 2619Second arg DEPTH forces the topic prefix to that depth, regardless 2620of the topics current depth. 2621 2622Third arg NUMBER-CONTROL can force the prefix to or away from 2623numbered form. It has effect only if 'outline-numbered-bullet' is 2624non-nil and soliciting was not explicitly invoked (via first arg). 2625Its effect, numbering or denumbering, then depends on the setting 2626of the forth arg, INDEX. 2627 2628If NUMBER-CONTROL is non-nil and forth arg INDEX is nil, then the 2629prefix of the topic is forced to be non-numbered. Null index and 2630non-nil NUMBER-CONTROL forces denumbering. Non-nil INDEX (and 2631non-nil NUMBER-CONTROL) forces a numbered-prefix form. If non-nil 2632INDEX is a number, then that number is used for the numbered 2633prefix. Non-nil and non-number means that the index for the 2634numbered prefix will be derived by outline-make-topic-prefix. 2635 2636Fifth arg DO-SUCCESSORS t means re-resolve count on succeeding 2637siblings. 2638 2639Cf vars 'outline-stylish-prefixes', 'outline-old-style-prefixes', 2640and 'outline-numbered-bullet', which all affect the behavior of 2641this function." 2642 2643 (let* ((current-depth (outline-depth)) 2644 (new-depth (or new-depth current-depth)) 2645 (mb outline-recent-prefix-beginning) 2646 (me outline-recent-prefix-end) 2647 (current-bullet (buffer-substring (- me 1) me)) 2648 (new-prefix (outline-make-topic-prefix current-bullet 2649 nil 2650 new-depth 2651 solicit 2652 number-control 2653 index))) 2654 2655 ;; Is new one is identical to old? 2656 (if (and (= current-depth new-depth) 2657 (string= current-bullet 2658 (substring new-prefix (1- (length new-prefix))))) 2659 ;; Nothing to do: 2660 t 2661 2662 ;; New prefix probably different from old: 2663 ; get rid of old one: 2664 (outline-unprotected (delete-region mb me)) 2665 (goto-char mb) 2666 ; Dispense with number if 2667 ; numbered-bullet prefix: 2668 (if (and outline-numbered-bullet 2669 (string= outline-numbered-bullet current-bullet) 2670 (looking-at "[0-9]+")) 2671 (outline-unprotected 2672 (delete-region (match-beginning 0)(match-end 0)))) 2673 2674 ; Put in new prefix: 2675 (outline-unprotected (insert-string new-prefix)) 2676 2677 ;; Reindent the body if elected and margin changed: 2678 (if (and outline-reindent-bodies 2679 (not (= new-depth current-depth))) 2680 (outline-reindent-body current-depth new-depth)) 2681 2682 ;; Recursively rectify successive siblings of orig topic if 2683 ;; caller elected for it: 2684 (if do-successors 2685 (save-excursion 2686 (while (outline-next-sibling new-depth nil) 2687 (setq index 2688 (cond ((numberp index) (1+ index)) 2689 ((not number-control) (outline-sibling-index)))) 2690 (if (outline-numbered-type-prefix) 2691 (outline-rebullet-heading nil ;;; solicit 2692 new-depth ;;; new-depth 2693 number-control;;; number-control 2694 index ;;; index 2695 nil))))) ;;;(dont!)do-successors 2696 ) ; (if (and (= current-depth new-depth)...)) 2697 ) ; let* ((current-depth (outline-depth))...) 2698 ) ; defun 2699;;;_ > outline-rebullet-topic (arg) 2700(defun outline-rebullet-topic (arg) 2701 "Like outline-rebullet-topic-grunt, but start from topic visible at point. 2702 2703Descends into invisible as well as visible topics, however. 2704 2705With repeat count, shift topic depth by that amount." 2706 (interactive "P") 2707 (let ((start-col (current-column)) 2708 (was-eol (eolp))) 2709 (save-excursion 2710 ;; Normalize arg: 2711 (cond ((null arg) (setq arg 0)) 2712 ((listp arg) (setq arg (car arg)))) 2713 ;; Fill the user in, in case we're shifting a big topic: 2714 (if (not (zerop arg)) (message "Shifting...")) 2715 (outline-back-to-current-heading) 2716 (if (<= (+ (outline-recent-depth) arg) 0) 2717 (error "Attempt to shift topic below level 1")) 2718 (outline-rebullet-topic-grunt arg) 2719 (if (not (zerop arg)) (message "Shifting... done."))) 2720 (move-to-column (max 0 (+ start-col arg))))) 2721;;;_ > outline-rebullet-topic-grunt (&optional relative-depth ...) 2722(defun outline-rebullet-topic-grunt (&optional relative-depth 2723 starting-depth 2724 starting-point 2725 index 2726 do-successors) 2727 2728 "Rebullet the topic at point, visible or invisible, and all 2729contained subtopics. See outline-rebullet-heading for rebulleting 2730behavior. 2731 2732All arguments are optional. 2733 2734First arg RELATIVE-DEPTH means to shift the depth of the entire 2735topic that amount. 2736 2737The rest of the args are for internal recursive use by the function 2738itself. The are STARTING-DEPTH, STARTING-POINT, and INDEX." 2739 2740 (let* ((relative-depth (or relative-depth 0)) 2741 (new-depth (outline-depth)) 2742 (starting-depth (or starting-depth new-depth)) 2743 (on-starting-call (null starting-point)) 2744 (index (or index 2745 ;; Leave index null on starting call, so rebullet-heading 2746 ;; calculates it at what might be new depth: 2747 (and (or (zerop relative-depth) 2748 (not on-starting-call)) 2749 (outline-sibling-index)))) 2750 (moving-outwards (< 0 relative-depth)) 2751 (starting-point (or starting-point (point)))) 2752 2753 ;; Sanity check for excessive promotion done only on starting call: 2754 (and on-starting-call 2755 moving-outwards 2756 (> 0 (+ starting-depth relative-depth)) 2757 (error "Attempt to shift topic out beyond level 1.")) ;;; ====> 2758 2759 (cond ((= starting-depth new-depth) 2760 ;; We're at depth to work on this one: 2761 (outline-rebullet-heading nil ;;; solicit 2762 (+ starting-depth ;;; starting-depth 2763 relative-depth) 2764 nil ;;; number 2765 index ;;; index 2766 ;; Every contained topic will get hit, 2767 ;; and we have to get to outside ones 2768 ;; deliberately: 2769 nil) ;;; do-successors 2770 ;; ... and work on subsequent ones which are at greater depth: 2771 (setq index 0) 2772 (outline-next-heading) 2773 (while (and (not (eobp)) 2774 (< starting-depth (outline-recent-depth))) 2775 (setq index (1+ index)) 2776 (outline-rebullet-topic-grunt relative-depth ;;; relative-depth 2777 (1+ starting-depth);;;starting-depth 2778 starting-point ;;; starting-point 2779 index))) ;;; index 2780 2781 ((< starting-depth new-depth) 2782 ;; Rare case - subtopic more than one level deeper than parent. 2783 ;; Treat this one at an even deeper level: 2784 (outline-rebullet-topic-grunt relative-depth ;;; relative-depth 2785 new-depth ;;; starting-depth 2786 starting-point ;;; starting-point 2787 index))) ;;; index 2788 2789 (if on-starting-call 2790 (progn 2791 ;; Rectify numbering of former siblings of the adjusted topic, 2792 ;; if topic has changed depth 2793 (if (or do-successors 2794 (and (not (zerop relative-depth)) 2795 (or (= (outline-recent-depth) starting-depth) 2796 (= (outline-recent-depth) (+ starting-depth 2797 relative-depth))))) 2798 (outline-rebullet-heading nil nil nil nil t)) 2799 ;; Now rectify numbering of new siblings of the adjusted topic, 2800 ;; if depth has been changed: 2801 (progn (goto-char starting-point) 2802 (if (not (zerop relative-depth)) 2803 (outline-rebullet-heading nil nil nil nil t))))) 2804 ) 2805 ) 2806;;;_ > outline-renumber-to-depth (&optional depth) 2807(defun outline-renumber-to-depth (&optional depth) 2808 "Renumber siblings at current depth. 2809 2810Affects superior topics if optional arg DEPTH is less than current depth. 2811 2812Returns final depth." 2813 2814 ;; Proceed by level, processing subsequent siblings on each, 2815 ;; ascending until we get shallower than the start depth: 2816 2817 (let ((ascender (outline-depth))) 2818 (while (and (not (eobp)) 2819 (outline-depth) 2820 (>= (outline-recent-depth) depth) 2821 (>= ascender depth)) 2822 ; Skip over all topics at 2823 ; lesser depths, which can not 2824 ; have been disturbed: 2825 (while (and (not (eobp)) 2826 (> (outline-recent-depth) ascender)) 2827 (outline-next-heading)) 2828 ; Prime ascender for ascension: 2829 (setq ascender (1- (outline-recent-depth))) 2830 (if (>= (outline-recent-depth) depth) 2831 (outline-rebullet-heading nil ;;; solicit 2832 nil ;;; depth 2833 nil ;;; number-control 2834 nil ;;; index 2835 t))));;; do-successors 2836 (outline-recent-depth)) 2837;;;_ > outline-number-siblings (&optional denumber) 2838(defun outline-number-siblings (&optional denumber) 2839 "Assign numbered topic prefix to this topic and its siblings. 2840 2841With universal argument, denumber - assign default bullet to this 2842topic and its siblings. 2843 2844With repeated universal argument (`^U^U'), solicit bullet for each 2845rebulleting each topic at this level." 2846 2847 (interactive "P") 2848 2849 (save-excursion 2850 (outline-back-to-current-heading) 2851 (outline-beginning-of-level) 2852 (let ((depth (outline-recent-depth)) 2853 (index (if (not denumber) 1)) 2854 (use-bullet (equal '(16) denumber)) 2855 (more t)) 2856 (while more 2857 (outline-rebullet-heading use-bullet ;;; solicit 2858 depth ;;; depth 2859 t ;;; number-control 2860 index ;;; index 2861 nil) ;;; do-successors 2862 (if index (setq index (1+ index))) 2863 (setq more (outline-next-sibling depth nil)))))) 2864;;;_ > outline-shift-in (arg) 2865(defun outline-shift-in (arg) 2866 "Increase depth of current heading and any topics collapsed within it." 2867 (interactive "p") 2868 (outline-rebullet-topic arg)) 2869;;;_ > outline-shift-out (arg) 2870(defun outline-shift-out (arg) 2871 "Decrease depth of current heading and any topics collapsed within it." 2872 (interactive "p") 2873 (outline-rebullet-topic (* arg -1))) 2874;;;_ : Surgery (kill-ring) functions with special provisions for outlines: 2875;;;_ > outline-kill-line (&optional arg) 2876(defun outline-kill-line (&optional arg) 2877 "Kill line, adjusting subsequent lines suitably for outline mode." 2878 2879 (interactive "*P") 2880 (if (not (and (outline-mode-p) ; active outline mode, 2881 outline-numbered-bullet ; numbers may need adjustment, 2882 (bolp) ; may be clipping topic head, 2883 (looking-at outline-regexp))) ; are clipping topic head. 2884 ;; Above conditions do not obtain - just do a regular kill: 2885 (kill-line arg) 2886 ;; Ah, have to watch out for adjustments: 2887 (let* ((depth (outline-depth))) 2888 ; Do the kill: 2889 (kill-line arg) 2890 ; Provide some feedback: 2891 (sit-for 0) 2892 (save-excursion 2893 ; Start with the topic 2894 ; following killed line: 2895 (if (not (looking-at outline-regexp)) 2896 (outline-next-heading)) 2897 (outline-renumber-to-depth depth))))) 2898;;;_ > outline-kill-topic () 2899(defun outline-kill-topic () 2900 "Kill topic together with subtopics. 2901 2902Leaves primary topic's trailing vertical whitespace, if any." 2903 2904 ;; Some finagling is done to make complex topic kills appear faster 2905 ;; than they actually are. A redisplay is performed immediately 2906 ;; after the region is disposed of, though the renumbering process 2907 ;; has yet to be performed. This means that there may appear to be 2908 ;; a lag *after* the kill has been performed. 2909 2910 (interactive) 2911 (let* ((beg (prog1 (outline-back-to-current-heading)(beginning-of-line))) 2912 (depth (outline-recent-depth))) 2913 (outline-end-of-current-subtree) 2914 (if (not (eobp)) 2915 (if (or (not (looking-at "^$")) 2916 ;; A blank line - cut it with this topic *unless* this 2917 ;; is the last topic at this level, in which case 2918 ;; we'll leave the blank line as part of the 2919 ;; containing topic: 2920 (save-excursion 2921 (and (outline-next-heading) 2922 (>= (outline-recent-depth) depth)))) 2923 (forward-char 1))) 2924 2925 (kill-region beg (point)) 2926 (sit-for 0) 2927 (save-excursion 2928 (outline-renumber-to-depth depth)))) 2929;;;_ > outline-yank-processing () 2930(defun outline-yank-processing (&optional arg) 2931 2932 "Incidental outline-specific business to be done just after text yanks. 2933 2934Does depth adjustment of yanked topics, when: 2935 29361 the stuff being yanked starts with a valid outline header prefix, and 29372 it is being yanked at the end of a line which consists of only a valid 2938 topic prefix. 2939 2940Also, adjusts numbering of subsequent siblings when appropropriate. 2941 2942Depth adjustment alters the depth of all the topics being yanked 2943the amount it takes to make the first topic have the depth of the 2944header into which it's being yanked. 2945 2946The point is left in front of yanked, adjusted topics, rather than 2947at the end (and vice-versa with the mark). Non-adjusted yanks, 2948however, are left exactly like normal, non-outline-specific yanks." 2949 2950 (interactive "*P") 2951 ; Get to beginning, leaving 2952 ; region around subject: 2953 (if (< (mark-marker) (point)) 2954 (exchange-point-and-mark)) 2955 (let* ((subj-beg (point)) 2956 (subj-end (mark-marker)) 2957 ;; 'resituate' if yanking an entire topic into topic header: 2958 (resituate (and (outline-e-o-prefix-p) 2959 (looking-at (concat "\\(" outline-regexp "\\)")) 2960 (outline-prefix-data (match-beginning 1) 2961 (match-end 1)))) 2962 ;; 'rectify-numbering' if resituating (where several topics may 2963 ;; be resituating) or yanking a topic into a topic slot (bol): 2964 (rectify-numbering (or resituate 2965 (and (bolp) (looking-at outline-regexp))))) 2966 (if resituate 2967 ; The yanked stuff is a topic: 2968 (let* ((prefix-len (- (match-end 1) subj-beg)) 2969 (subj-depth (outline-recent-depth)) 2970 (prefix-bullet (outline-recent-bullet)) 2971 (adjust-to-depth 2972 ;; Nil if adjustment unnecessary, otherwise depth to which 2973 ;; adjustment should be made: 2974 (save-excursion 2975 (and (goto-char subj-end) 2976 (eolp) 2977 (goto-char subj-beg) 2978 (and (looking-at outline-regexp) 2979 (progn 2980 (beginning-of-line) 2981 (not (= (point) subj-beg))) 2982 (looking-at outline-regexp) 2983 (outline-prefix-data (match-beginning 0) 2984 (match-end 0))) 2985 (outline-recent-depth)))) 2986 done 2987 (more t)) 2988 (setq rectify-numbering outline-numbered-bullet) 2989 (if adjust-to-depth 2990 ; Do the adjustment: 2991 (progn 2992 (message "... yanking") (sit-for 0) 2993 (save-restriction 2994 (narrow-to-region subj-beg subj-end) 2995 ; Trim off excessive blank 2996 ; line at end, if any: 2997 (goto-char (point-max)) 2998 (if (looking-at "^$") 2999 (outline-unprotected (delete-char -1))) 3000 ; Work backwards, with each 3001 ; shallowest level, 3002 ; successively excluding the 3003 ; last processed topic from 3004 ; the narrow region: 3005 (while more 3006 (outline-back-to-current-heading) 3007 ; go as high as we can in each bunch: 3008 (while (outline-ascend-to-depth (1- (outline-depth)))) 3009 (save-excursion 3010 (outline-rebullet-topic-grunt (- adjust-to-depth 3011 subj-depth)) 3012 (outline-depth)) 3013 (if (setq more (not (bobp))) 3014 (progn (widen) 3015 (forward-char -1) 3016 (narrow-to-region subj-beg (point)))))) 3017 (message "") 3018 ;; Preserve new bullet if it's a distinctive one, otherwise 3019 ;; use old one: 3020 (if (string-match (regexp-quote prefix-bullet) 3021 outline-distinctive-bullets-string) 3022 ; Delete from bullet of old to 3023 ; before bullet of new: 3024 (progn 3025 (beginning-of-line) 3026 (delete-region (point) subj-beg) 3027 (set-marker (mark-marker) subj-end) 3028 (goto-char subj-beg) 3029 (outline-end-of-prefix)) 3030 ; Delete base subj prefix, 3031 ; leaving old one: 3032 (delete-region (point) (+ (point) 3033 prefix-len 3034 (- adjust-to-depth subj-depth))) 3035 ; and delete residual subj 3036 ; prefix digits and space: 3037 (while (looking-at "[0-9]") (delete-char 1)) 3038 (if (looking-at " ") (delete-char 1)))) 3039 (exchange-point-and-mark)))) 3040 (if rectify-numbering 3041 (progn 3042 (save-excursion 3043 ; Give some preliminary feedback: 3044 (message "... reconciling numbers") (sit-for 0) 3045 ; ... and renumber, in case necessary: 3046 (goto-char subj-beg) 3047 (if (outline-goto-prefix) 3048 (outline-rebullet-heading nil ;;; solicit 3049 (outline-depth) ;;; depth 3050 nil ;;; number-control 3051 nil ;;; index 3052 t)) 3053 (message "")))) 3054 (if (not resituate) 3055 (exchange-point-and-mark)))) 3056;;;_ > outline-yank (&optional arg) 3057(defun outline-yank (&optional arg) 3058 "Outline-mode yank, with depth and numbering adjustment of yanked topics. 3059 3060Non-topic yanks work no differntly than normal yanks. 3061 3062If a topic is being yanked into a bare topic prefix, the depth of the 3063yanked topic is adjusted to the depth of the topic prefix. 3064 3065 1 we're yanking in an outline-mode buffer 3066 2 the stuff being yanked starts with a valid outline header prefix, and 3067 3 it is being yanked at the end of a line which consists of only a valid 3068 topic prefix. 3069 3070If these conditions hold then the depth of the yanked topics are all 3071adjusted the amount it takes to make the first one at the depth of the 3072header into which it's being yanked. 3073 3074The point is left in front of yanked, adjusted topics, rather than 3075at the end (and vice-versa with the mark). Non-adjusted yanks, 3076however, (ones that don't qualify for adjustment) are handled 3077exactly like normal yanks. 3078 3079Numbering of yanked topics, and the succesive siblings at the depth 3080into which they're being yanked, is adjusted. 3081 3082Outline-yank-pop works with outline-yank just like normal yank-pop 3083works with normal yank in non-outline buffers." 3084 3085 (interactive "*P") 3086 (setq this-command 'yank) 3087 (yank arg) 3088 (if (outline-mode-p) 3089 (outline-yank-processing))) 3090;;;_ > outline-yank-pop (&optional arg) 3091(defun outline-yank-pop (&optional arg) 3092 "Yank-pop like outline-yank when popping to bare outline prefixes. 3093 3094Adapts level of popped topics to level of fresh prefix. 3095 3096Note - prefix changes to distinctive bullets will stick, if followed 3097by pops to non-distinctive yanks. Bug..." 3098 3099 (interactive "*p") 3100 (setq this-command 'yank) 3101 (yank-pop arg) 3102 (if (outline-mode-p) 3103 (outline-yank-processing))) 3104 3105;;;_ - Specialty bullet functions 3106;;;_ : File Cross references 3107;;;_ > outline-resolve-xref () 3108(defun outline-resolve-xref () 3109 "Pop to file associated with current heading, if it has an xref bullet. 3110 3111\(Works according to setting of `outline-file-xref-bullet')." 3112 (interactive) 3113 (if (not outline-file-xref-bullet) 3114 (error 3115 "outline cross references disabled - no 'outline-file-xref-bullet'") 3116 (if (not (string= (outline-current-bullet) outline-file-xref-bullet)) 3117 (error "current heading lacks cross-reference bullet '%s'" 3118 outline-file-xref-bullet) 3119 (let (file-name) 3120 (save-excursion 3121 (let* ((text-start outline-recent-prefix-end) 3122 (heading-end (progn (outline-pre-next-preface) 3123 (point)))) 3124 (goto-char text-start) 3125 (setq file-name 3126 (if (re-search-forward "\\s-\\(\\S-*\\)" heading-end t) 3127 (buffer-substring (match-beginning 1) (match-end 1)))))) 3128 (setq file-name 3129 (if (not (= (aref file-name 0) ?:)) 3130 (expand-file-name file-name) 3131 ; A registry-files ref, strip the ':' 3132 ; and try to follow it: 3133 (let ((reg-ref (reference-registered-file 3134 (substring file-name 1) nil t))) 3135 (if reg-ref (car (cdr reg-ref)))))) 3136 (if (or (file-exists-p file-name) 3137 (if (file-writable-p file-name) 3138 (y-or-n-p (format "%s not there, create one? " 3139 file-name)) 3140 (error "%s not found and can't be created" file-name))) 3141 (condition-case failure 3142 (find-file-other-window file-name) 3143 (error failure)) 3144 (error "%s not found" file-name)) 3145 ) 3146 ) 3147 ) 3148 ) 3149 3150;;;_ #6 Exposure Control and Processing 3151 3152;;;_ - Fundamental 3153;;;_ > outline-flag-region (from to flag) 3154(defmacro outline-flag-region (from to flag) 3155 "Hide or show lines from FROM to TO, via emacs selective-display FLAG char. 3156Ie, text following flag C-m \(carriage-return) is hidden until the 3157next C-j (newline) char. 3158 3159Returns the endpoint of the region." 3160 (` (let ((buffer-read-only nil) 3161 (outline-override-protect t)) 3162 (subst-char-in-region (, from) (, to) 3163 (if (= (, flag) ?\n) ?\r ?\n) 3164 (, flag) t)))) 3165;;;_ > outline-flag-current-subtree (flag) 3166(defun outline-flag-current-subtree (flag) 3167 "Hide or show subtree of currently-visible topic. 3168 3169See `outline-flag-region' for more details." 3170 3171 (save-excursion 3172 (outline-back-to-current-heading) 3173 (outline-flag-region (point) 3174 (progn (outline-end-of-current-subtree) (1- (point))) 3175 flag))) 3176 3177;;;_ - Mapping and processing of topics 3178;;;_ " See also chart functions, in navigation 3179;;;_ > outline-listify-exposed (&optional start end) 3180(defun outline-listify-exposed (&optional start end) 3181 3182 "Produce a list representing exposed topics in current region. 3183 3184This list can then be used by 'outline-process-exposed' to manipulate 3185the subject region. 3186 3187List is composed of elements that may themselves be lists representing 3188exposed components in subtopic. 3189 3190Each component list contains: 3191 - a number representing the depth of the topic, 3192 - a string representing the header-prefix (ref. 'outline-header-prefix'), 3193 - a string representing the bullet character, 3194 - and a series of strings, each containing one line of the exposed 3195 portion of the topic entry." 3196 3197 (interactive "r") 3198 (save-excursion 3199 (let* (strings pad result depth bullet beg next done) ; State vars. 3200 (goto-char start) 3201 (beginning-of-line) 3202 (if (not (outline-goto-prefix)) ; Get initial position within a topic: 3203 (outline-next-visible-heading 1)) 3204 (while (and (not done) 3205 (not (eobp)) ; Loop until we've covered the region. 3206 (not (> (point) end))) 3207 (setq depth (outline-recent-depth) ; Current topics' depth, 3208 bullet (outline-recent-bullet) ; ... bullet, 3209 beg (progn (outline-end-of-prefix t) (point))) ; and beginning. 3210 (setq done ; The boundary for the current topic: 3211 (not (outline-next-visible-heading 1))) 3212 (beginning-of-line) 3213 (setq next (point)) 3214 (goto-char beg) 3215 (setq strings nil) 3216 (while (> next (point)) ; Get all the exposed text in 3217 (setq strings 3218 (cons (buffer-substring 3219 beg 3220 ;To hidden text or end of line: 3221 (progn 3222 (search-forward "\r" 3223 (save-excursion (end-of-line) 3224 (point)) 3225 1) 3226 (if (= (preceding-char) ?\r) 3227 (1- (point)) 3228 (point)))) 3229 strings)) 3230 (if (< (point) next) ; Resume from after hid text, if any. 3231 (forward-line 1)) 3232 (setq beg (point))) 3233 ;; Accumulate list for this topic: 3234 (setq result 3235 (cons (append (list depth 3236 outline-header-prefix 3237 bullet) 3238 (nreverse strings)) 3239 result))) 3240 ;; Put the list with first at front, to last at back: 3241 (nreverse result)))) 3242;;;_ > outline-process-exposed (arg &optional tobuf) 3243(defun outline-process-exposed (&optional func from to frombuf tobuf) 3244 "Map function on exposed parts of current topic; results to another buffer. 3245 3246Apply FUNCTION \(default 'outline-insert-listified) to exposed 3247portions FROM position TO position \(default region, or the entire 3248buffer if no region active) in buffer FROMBUF \(default current 3249buffer) to buffer TOBUF \(default is buffer named like frombuf but 3250with \"*\" prepended and \" exposed*\" appended). 3251 3252The function must as its arguments the elements of the list 3253representations of topic entries produced by outline-listify-exposed." 3254 3255 ; Resolve arguments, 3256 ; defaulting if necessary: 3257 (if (not func) (setq func 'outline-insert-listified)) 3258 (if (not (and from to)) 3259 (if mark-active 3260 (setq from (region-beginning) to (region-end)) 3261 (setq from (point-min) to (point-max)))) 3262 (if frombuf 3263 (if (not (bufferp frombuf)) 3264 ;; Specified but not a buffer - get it: 3265 (let ((got (get-buffer frombuf))) 3266 (if (not got) 3267 (error (concat "outline-process-exposed: source buffer " 3268 frombuf 3269 " not found.")) 3270 (setq frombuf got)))) 3271 ;; not specified - default it: 3272 (setq frombuf (current-buffer))) 3273 (if tobuf 3274 (if (not (bufferp tobuf)) 3275 (setq tobuf (get-buffer-create tobuf))) 3276 ;; not specified - default it: 3277 (setq tobuf (concat "*" (buffer-name frombuf) " exposed*"))) 3278 3279 (let* ((listified (progn (set-buffer frombuf) 3280 (outline-listify-exposed from to))) 3281 (prefix outline-header-prefix) ; ... as set in frombuf. 3282 curr) 3283 (set-buffer tobuf) 3284 (while listified 3285 (setq curr (car listified)) 3286 (setq listified (cdr listified)) 3287 (apply func (list (car curr) ; depth 3288 (car (cdr curr)) ; header-prefix 3289 (car (cdr (cdr curr))) ; bullet 3290 (cdr (cdr (cdr curr)))))) ; list of text lines 3291 (pop-to-buffer tobuf))) 3292 3293;;;_ - Topic-specific 3294;;;_ > outline-show-entry () 3295; outline-show-entry basically for isearch dynamic exposure, as is... 3296(defun outline-show-entry () 3297 "Like `outline-show-current-entry', reveals entries nested in hidden topics. 3298 3299This is a way to give restricted peek at a concealed locality without the 3300expense of exposing its context, but can leave the outline with aberrant 3301exposure. outline-hide-current-entry-completely or outline-show-offshoot 3302should be used after the peek to rectify the exposure." 3303 3304 (interactive) 3305 (save-excursion 3306 (outline-goto-prefix) 3307 (outline-flag-region (if (bobp) (point) (1- (point))) 3308 (or (outline-pre-next-preface) (point)) 3309 ?\n))) 3310;;;_ > outline-show-children (&optional level strict) 3311(defun outline-show-children (&optional level strict) 3312 3313 "If point is visible, show all direct subheadings of this heading. 3314 3315Otherwise, do outline-show-to-offshoot, and then show subheadings. 3316 3317Optional LEVEL specifies how many levels below the current level 3318should be shown, or all levels if t. Default is 1. 3319 3320Optional STRICT means don't resort to -show-to-offshoot, no matter 3321what. This is basically so -show-to-offshoot, which is called by 3322this function, can employ the pure offspring-revealing capabilities of 3323it. 3324 3325Returns point at end of subtree that was opened, if any. (May get a 3326point of non-opened subtree?)" 3327 3328 (interactive "p") 3329 (let (max-pos) 3330 (if (and (not strict) 3331 (outline-hidden-p)) 3332 3333 (progn (outline-show-to-offshoot) ; Point's concealed, open to 3334 ; expose it. 3335 ;; Then recurse, but with "strict" set so we don't 3336 ;; infinite regress: 3337 (setq max-pos (outline-show-children level t))) 3338 3339 (save-excursion 3340 (save-restriction 3341 (let* ((start-pt (point)) 3342 (chart (outline-chart-subtree (or level 1))) 3343 (to-reveal (outline-chart-to-reveal chart (or level 1)))) 3344 (goto-char start-pt) 3345 (if (and strict (= (preceding-char) ?\r)) 3346 ;; Concealed root would already have been taken care of, 3347 ;; unless strict was set. 3348 (outline-flag-region (point) (outline-snug-back) ?\n)) 3349 (while to-reveal 3350 (goto-char (car to-reveal)) 3351 (outline-flag-region (point) (outline-snug-back) ?\n) 3352 (setq to-reveal (cdr to-reveal))))))))) 3353;;;_ x outline-show-current-children (&optional level strict) 3354(defun outline-show-current-children (&optional level strict) 3355 "This command was misnamed, use `outline-show-children' instead. 3356 3357\(The \"current\" in the name is supposed to imply that it works on 3358the visible topic containing point, while it really works with respect 3359to the most immediate topic, concealed or not. I'll leave this old 3360name around for a bit, but i'll soon activate an annoying message to 3361warn people about the change, and then deprecate this alias." 3362 3363 (interactive "p") 3364 ;;(beep) 3365 ;;(message (format "Use '%s' instead of '%s' (%s)." 3366 ;; "outline-show-children" 3367 ;; "outline-show-current-children" 3368 ;; (buffer-name (current-buffer)))) 3369 (outline-show-children level strict)) 3370;;;_ > outline-hide-point-reconcile () 3371(defun outline-hide-reconcile () 3372 "Like `outline-hide-current-entry'; hides completely if within hidden region. 3373 3374Specifically intended for aberrant exposure states, like entries that were 3375exposed by outline-show-entry but are within otherwise concealed regions." 3376 (interactive) 3377 (save-excursion 3378 (outline-goto-prefix) 3379 (outline-flag-region (if (not (bobp)) (1- (point)) (point)) 3380 (progn (outline-pre-next-preface) 3381 (if (= ?\r (following-char)) 3382 (point) 3383 (1- (point)))) 3384 ?\r))) 3385;;;_ > outline-show-to-offshoot () 3386(defun outline-show-to-offshoot () 3387 "Like outline-show-entry, but reveals opens all concealed ancestors, as well. 3388 3389As with outline-hide-current-entry-completely, useful for rectifying 3390aberrant exposure states produced by outline-show-entry." 3391 3392 (interactive) 3393 (save-excursion 3394 (let ((orig-pt (point)) 3395 (orig-pref (outline-goto-prefix)) 3396 (last-at (point)) 3397 bag-it) 3398 (while (or bag-it (= (preceding-char) ?\r)) 3399 (beginning-of-line) 3400 (if (= last-at (setq last-at (point))) 3401 ;; Oops, we're not making any progress! Show the current 3402 ;; topic completely, and bag this try. 3403 (progn (beginning-of-line) 3404 (outline-show-current-subtree) 3405 (goto-char orig-pt) 3406 (setq bag-it t) 3407 (beep) 3408 (message "%s: %s" 3409 "outline-show-to-offshoot: " 3410 "Aberrant nesting encountered."))) 3411 (outline-show-children) 3412 (goto-char orig-pref)) 3413 (goto-char orig-pt))) 3414 (if (outline-hidden-p) 3415 (outline-show-entry))) 3416;;;_ > outline-hide-current-entry () 3417(defun outline-hide-current-entry () 3418 "Hide the body directly following this heading." 3419 (interactive) 3420 (outline-back-to-current-heading) 3421 (save-excursion 3422 (outline-flag-region (point) 3423 (progn (outline-end-of-current-entry) (point)) 3424 ?\^M))) 3425;;;_ > outline-show-current-entry (&optional arg) 3426(defun outline-show-current-entry (&optional arg) 3427 3428 "Show body following current heading, or hide the entry if repeat count." 3429 3430 (interactive "P") 3431 (if arg 3432 (outline-hide-current-entry) 3433 (save-excursion 3434 (outline-flag-region (point) 3435 (progn (outline-end-of-current-entry) (point)) 3436 ?\n)))) 3437;;;_ > outline-hide-current-entry-completely () 3438; ... outline-hide-current-entry-completely also for isearch dynamic exposure: 3439(defun outline-hide-current-entry-completely () 3440 "Like outline-hide-current-entry, but conceal topic completely. 3441 3442Specifically intended for aberrant exposure states, like entries that were 3443exposed by outline-show-entry but are within otherwise concealed regions." 3444 (interactive) 3445 (save-excursion 3446 (outline-goto-prefix) 3447 (outline-flag-region (if (not (bobp)) (1- (point)) (point)) 3448 (progn (outline-pre-next-preface) 3449 (if (= ?\r (following-char)) 3450 (point) 3451 (1- (point)))) 3452 ?\r))) 3453;;;_ > outline-show-current-subtree (&optional arg) 3454(defun outline-show-current-subtree (&optional arg) 3455 "Show everything within the current topic. With a repeat-count, 3456expose this topic and its' siblings." 3457 (interactive "P") 3458 (save-excursion 3459 (if (<= (outline-current-depth) 0) 3460 ;; Outside any topics - try to get to the first: 3461 (if (not (outline-next-heading)) 3462 (error "No topics.") 3463 ;; got to first, outermost topic - set to expose it and siblings: 3464 (message "Above outermost topic - exposing all.") 3465 (outline-flag-region (point-min)(point-max) ?\n)) 3466 (if (not arg) 3467 (outline-flag-current-subtree ?\n) 3468 (outline-beginning-of-level) 3469 (outline-expose-topic '(* :)))))) 3470;;;_ > outline-hide-current-subtree (&optional just-close) 3471(defun outline-hide-current-subtree (&optional just-close) 3472 "Close the current topic, or containing topic if this one is already closed. 3473 3474If this topic is closed and it's a top level topic, close this topic 3475and its' siblings. 3476 3477If optional arg JUST-CLOSE is non-nil, do not treat the parent or 3478siblings, even if the target topic is already closed." 3479 3480 (interactive) 3481 (let ((from (point)) 3482 (orig-eol (progn (end-of-line) 3483 (if (not (outline-goto-prefix)) 3484 (error "No topics found.") 3485 (end-of-line)(point))))) 3486 (outline-flag-current-subtree ?\^M) 3487 (goto-char from) 3488 (if (and (= orig-eol (progn (goto-char orig-eol) 3489 (end-of-line) 3490 (point))) 3491 (not just-close) 3492 ;; Structure didn't change - try hiding current level: 3493 (goto-char from) 3494 (if (outline-up-current-level 1 t) 3495 t 3496 (goto-char 0) 3497 (let ((msg 3498 "Top-level topic already closed - closing siblings...")) 3499 (message msg) 3500 (outline-expose-topic '(0 :)) 3501 (message (concat msg " Done."))) 3502 nil) 3503 (/= (outline-recent-depth) 0)) 3504 (outline-hide-current-subtree)) 3505 (goto-char from))) 3506;;;_ > outline-show-current-branches () 3507(defun outline-show-current-branches () 3508 "Show all subheadings of this heading, but not their bodies." 3509 (interactive) 3510 (beginning-of-line) 3511 (outline-show-children t)) 3512;;;_ > outline-hide-current-leaves () 3513(defun outline-hide-current-leaves () 3514 "Hide the bodies of the current topic and all its' offspring." 3515 (interactive) 3516 (outline-back-to-current-heading) 3517 (outline-hide-region-body (point) (progn (outline-end-of-current-subtree) 3518 (point)))) 3519 3520;;;_ - Region and beyond 3521;;;_ > outline-show-all () 3522(defun outline-show-all () 3523 "Show all of the text in the buffer." 3524 (interactive) 3525 (message "Exposing entire buffer...") 3526 (outline-flag-region (point-min) (point-max) ?\n) 3527 (message "Exposing entire buffer... Done.")) 3528;;;_ > outline-hide-bodies () 3529(defun outline-hide-bodies () 3530 "Hide all of buffer except headings." 3531 (interactive) 3532 (outline-hide-region-body (point-min) (point-max))) 3533;;;_ > outline-hide-region-body (start end) 3534(defun outline-hide-region-body (start end) 3535 "Hide all body lines in the region, but not headings." 3536 (save-excursion 3537 (save-restriction 3538 (narrow-to-region start end) 3539 (goto-char (point-min)) 3540 (while (not (eobp)) 3541 (outline-flag-region (point) 3542 (progn (outline-pre-next-preface) (point)) ?\^M) 3543 (if (not (eobp)) 3544 (forward-char 3545 (if (looking-at "[\n\r][\n\r]") 3546 2 1))))))) 3547 3548;;;_ > outline-expose-topic (spec) 3549(defun outline-expose-topic (spec) 3550 "Apply exposure specs to successive outline topic items. 3551 3552Use the more convenient frontend, `outline-new-exposure', if you don't 3553need evaluation of the arguments, or even better, the `outline-layout' 3554variable-keyed mode-activation/auto-exposure feature of allout outline 3555mode. See the respective documentation strings for more details. 3556 3557Cursor is left at start position. 3558 3559SPEC is either a number or a list. 3560 3561Successive specs on a list are applied to successive sibling topics. 3562 3563A simple spec \(either a number, one of a few symbols, or the null 3564list) dictates the exposure for the corresponding topic. 3565 3566Non-null lists recursively designate exposure specs for respective 3567subtopics of the current topic. 3568 3569The ':' repeat spec is used to specify exposure for any number of 3570successive siblings, up to the trailing ones for which there are 3571explicit specs following the ':'. 3572 3573Simple (numeric and null-list) specs are interpreted as follows: 3574 3575 Numbers indicate the relative depth to open the corresponding topic. 3576 - negative numbers force the topic to be closed before opening to the 3577 absolute value of the number, so all siblings are open only to 3578 that level. 3579 - positive numbers open to the relative depth indicated by the 3580 number, but do not force already opened subtopics to be closed. 3581 - 0 means to close topic - hide all offspring. 3582 : - 'repeat' 3583 apply prior element to all siblings at current level, *up to* 3584 those siblings that would be covered by specs following the ':' 3585 on the list. Ie, apply to all topics at level but the last 3586 ones. \(Only first of multiple colons at same level is 3587 respected - subsequent ones are discarded.) 3588 * - completely opens the topic, including bodies. 3589 + - shows all the sub headers, but not the bodies 3590 - - exposes the body of the corresponding topic. 3591 3592Examples: 3593\(outline-expose-topic '(-1 : 0)) 3594 Close this and all following topics at current level, exposing 3595 only their immediate children, but close down the last topic 3596 at this current level completely. 3597\(outline-expose-topic '(-1 () : 1 0)) 3598 Close current topic so only the immediate subtopics are shown; 3599 show the children in the second to last topic, and completely 3600 close the last one. 3601\(outline-expose-topic '(-2 : -1 *)) 3602 Expose children and grandchildren of all topics at current 3603 level except the last two; expose children of the second to 3604 last and completely open the last one." 3605 3606 (interactive "xExposure spec: ") 3607 (if (not (listp spec)) 3608 nil 3609 (let ((depth (outline-depth)) 3610 (max-pos 0) 3611 prev-elem curr-elem 3612 stay done 3613 snug-back 3614 ) 3615 (while spec 3616 (setq prev-elem curr-elem 3617 curr-elem (car spec) 3618 spec (cdr spec)) 3619 (cond ; Do current element: 3620 ((null curr-elem) nil) 3621 ((symbolp curr-elem) 3622 (cond ((eq curr-elem '*) (outline-show-current-subtree) 3623 (if (> outline-recent-end-of-subtree max-pos) 3624 (setq max-pos outline-recent-end-of-subtree))) 3625 ((eq curr-elem '+) (outline-show-current-branches) 3626 (if (> outline-recent-end-of-subtree max-pos) 3627 (setq max-pos outline-recent-end-of-subtree))) 3628 ((eq curr-elem '-) (outline-show-current-entry)) 3629 ((eq curr-elem ':) 3630 (setq stay t) 3631 ;; Expand the 'repeat' spec to an explicit version, 3632 ;; w.r.t. remaining siblings: 3633 (let ((residue ; = # of sibs not covered by remaining spec 3634 ;; Dang - could be nice to make use of the chart, sigh: 3635 (- (length (outline-chart-siblings)) 3636 (length spec)))) 3637 (if (< 0 residue) 3638 ;; Some residue - cover it with prev-elem: 3639 (setq spec (append (make-list residue prev-elem) 3640 spec))))))) 3641 ((numberp curr-elem) 3642 (if (and (>= 0 curr-elem) (outline-visible-p)) 3643 (save-excursion (outline-hide-current-subtree t) 3644 (if (> 0 curr-elem) 3645 nil 3646 (if (> outline-recent-end-of-subtree max-pos) 3647 (setq max-pos 3648 outline-recent-end-of-subtree))))) 3649 (if (> (abs curr-elem) 0) 3650 (progn (outline-show-children (abs curr-elem)) 3651 (if (> outline-recent-end-of-subtree max-pos) 3652 (setq max-pos outline-recent-end-of-subtree))))) 3653 ((listp curr-elem) 3654 (if (outline-descend-to-depth (1+ depth)) 3655 (let ((got (outline-expose-topic curr-elem))) 3656 (if (and got (> got max-pos)) (setq max-pos got)))))) 3657 (cond (stay (setq stay nil)) 3658 ((listp (car spec)) nil) 3659 ((> max-pos (point)) 3660 ;; Capitalize on max-pos state to get us nearer next sibling: 3661 (progn (goto-char (min (point-max) max-pos)) 3662 (outline-next-heading))) 3663 ((outline-next-sibling depth)))) 3664 max-pos))) 3665;;;_ > outline-old-expose-topic (spec &rest followers) 3666(defun outline-old-expose-topic (spec &rest followers) 3667 3668 "Deprecated. Use outline-expose-topic \(with different schema 3669format\) instead. 3670 3671Dictate wholesale exposure scheme for current topic, according to SPEC. 3672 3673SPEC is either a number or a list. Optional successive args 3674dictate exposure for subsequent siblings of current topic. 3675 3676A simple spec (either a number, a special symbol, or the null list) 3677dictates the overall exposure for a topic. Non null lists are 3678composite specs whose first element dictates the overall exposure for 3679a topic, with the subsequent elements in the list interpreted as specs 3680that dictate the exposure for the successive offspring of the topic. 3681 3682Simple (numeric and null-list) specs are interpreted as follows: 3683 3684 - Numbers indicate the relative depth to open the corresponding topic: 3685 - negative numbers force the topic to be close before opening to the 3686 absolute value of the number. 3687 - positive numbers just open to the relative depth indicated by the number. 3688 - 0 just closes 3689 - '*' completely opens the topic, including bodies. 3690 - '+' shows all the sub headers, but not the bodies 3691 - '-' exposes the body and immediate offspring of the corresponding topic. 3692 3693If the spec is a list, the first element must be a number, which 3694dictates the exposure depth of the topic as a whole. Subsequent 3695elements of the list are nested SPECs, dictating the specific exposure 3696for the corresponding offspring of the topic. 3697 3698Optional FOLLOWER arguments dictate exposure for succeeding siblings." 3699 3700 (interactive "xExposure spec: ") 3701 (let ((depth (outline-current-depth)) 3702 done 3703 max-pos) 3704 (cond ((null spec) nil) 3705 ((symbolp spec) 3706 (if (eq spec '*) (outline-show-current-subtree)) 3707 (if (eq spec '+) (outline-show-current-branches)) 3708 (if (eq spec '-) (outline-show-current-entry))) 3709 ((numberp spec) 3710 (if (>= 0 spec) 3711 (save-excursion (outline-hide-current-subtree t) 3712 (end-of-line) 3713 (if (or (not max-pos) 3714 (> (point) max-pos)) 3715 (setq max-pos (point))) 3716 (if (> 0 spec) 3717 (setq spec (* -1 spec))))) 3718 (if (> spec 0) 3719 (outline-show-children spec))) 3720 ((listp spec) 3721 ;(let ((got (outline-old-expose-topic (car spec)))) 3722 ; (if (and got (or (not max-pos) (> got max-pos))) 3723 ; (setq max-pos got))) 3724 (let ((new-depth (+ (outline-current-depth) 1)) 3725 got) 3726 (setq max-pos (outline-old-expose-topic (car spec))) 3727 (setq spec (cdr spec)) 3728 (if (and spec 3729 (outline-descend-to-depth new-depth) 3730 (not (outline-hidden-p))) 3731 (progn (setq got (apply 'outline-old-expose-topic spec)) 3732 (if (and got (or (not max-pos) (> got max-pos))) 3733 (setq max-pos got))))))) 3734 (while (and followers 3735 (progn (if (and max-pos (< (point) max-pos)) 3736 (progn (goto-char max-pos) 3737 (setq max-pos nil))) 3738 (end-of-line) 3739 (outline-next-sibling depth))) 3740 (outline-old-expose-topic (car followers)) 3741 (setq followers (cdr followers))) 3742 max-pos)) 3743;;;_ > outline-new-exposure '() 3744(defmacro outline-new-exposure (&rest spec) 3745 "Literal frontend for `outline-expose-topic', doesn't evaluate arguments. 3746Some arguments that would need to be quoted in outline-expose-topic 3747need not be quoted in outline-new-exposure. 3748 3749Cursor is left at start position. 3750 3751Use this instead of obsolete 'outline-exposure'. 3752 3753Examples: 3754\(outline-exposure (-1 () () () 1) 0) 3755 Close current topic at current level so only the immediate 3756 subtopics are shown, except also show the children of the 3757 third subtopic; and close the next topic at the current level. 3758\(outline-exposure : -1 0) 3759 Close all topics at current level to expose only their 3760 immediate children, except for the last topic at the current 3761 level, in which even its' immediate children are hidden. 3762\(outline-exposure -2 : -1 *) 3763 Expose children and grandchildren of first topic at current 3764 level, and expose children of subsequent topics at current 3765 level *except* for the last, which should be opened completely." 3766 (list 'save-excursion 3767 '(if (not (or (outline-goto-prefix) 3768 (outline-next-heading))) 3769 (error "outline-new-exposure: Can't find any outline topics.")) 3770 (list 'outline-expose-topic (list 'quote spec)))) 3771;;;_ > outline-exposure '() 3772(defmacro outline-exposure (&rest spec) 3773 "Being deprecated - use more recent 'outline-new-exposure' instead. 3774 3775Literal frontend for `outline-old-expose-topic', doesn't evaluate arguments 3776and retains start position." 3777 (list 'save-excursion 3778 '(if (not (or (outline-goto-prefix) 3779 (outline-next-heading))) 3780 (error "Can't find any outline topics.")) 3781 (cons 'outline-old-expose-topic 3782 (mapcar '(lambda (x) (list 'quote x)) spec)))) 3783 3784;;;_ #7 ISearch with Dynamic Exposure 3785;;;_ = outline-search-reconceal 3786(defvar outline-search-reconceal nil 3787 "Track whether current search match was concealed outside of search. 3788 3789The value is the location of the match, if it was concealed, regular 3790if the entire topic was concealed, in a list if the entry was concealed.") 3791;;;_ = outline-search-quitting 3792(defconst outline-search-quitting nil 3793 "Distinguishes isearch conclusion and cancellation. 3794 3795Used by isearch-terminate/outline-provisions and 3796isearch-done/outline-provisions") 3797 3798 3799;;;_ > outline-enwrap-isearch () 3800(defun outline-enwrap-isearch () 3801 "Impose outline-mode isearch-mode wrappers for dynamic exposure in isearch. 3802 3803Isearch progressively exposes and reconceals hidden topics when 3804working in outline mode, but works normally elsewhere. 3805 3806The function checks to ensure that the rebindings are done only once." 3807 3808 ; Should isearch-mode be employed, 3809 (if (or (not outline-enwrap-isearch-mode) 3810 ; or are preparations already done? 3811 (fboundp 'real-isearch-terminate)) 3812 3813 ;; ... no - skip this all: 3814 nil 3815 3816 ;; ... yes: 3817 3818 ; Ensure load of isearch-mode: 3819 (if (or (and (fboundp 'isearch-mode) 3820 (fboundp 'isearch-quote-char)) 3821 (condition-case error 3822 (load-library outline-enwrap-isearch-mode) 3823 (file-error (message "Skipping isearch-mode provisions - %s '%s'" 3824 (car (cdr error)) 3825 (car (cdr (cdr error)))) 3826 (sit-for 1) 3827 ;; Inhibit subsequent tries and return nil: 3828 (setq outline-enwrap-isearch-mode nil)))) 3829 ;; Isearch-mode loaded, encapsulate specific entry points for 3830 ;; outline dynamic-exposure business: 3831 (progn 3832 3833 ;; stash crucial isearch-mode funcs under known, private 3834 ;; names, then register wrapper functions under the old 3835 ;; names, in their stead: 'isearch-quit' is pre isearch v 1.2. 3836 (fset 'real-isearch-terminate 3837 ; 'isearch-quit is pre v 1.2: 3838 (or (if (fboundp 'isearch-quit) 3839 (symbol-function 'isearch-quit)) 3840 (if (fboundp 'isearch-abort) 3841 ; 'isearch-abort' is v 1.2 and on: 3842 (symbol-function 'isearch-abort)))) 3843 (fset 'isearch-quit 'isearch-terminate/outline-provisions) 3844 (fset 'isearch-abort 'isearch-terminate/outline-provisions) 3845 (fset 'real-isearch-done (symbol-function 'isearch-done)) 3846 (fset 'isearch-done 'isearch-done/outline-provisions) 3847 (fset 'real-isearch-update (symbol-function 'isearch-update)) 3848 (fset 'isearch-update 'isearch-update/outline-provisions) 3849 (make-variable-buffer-local 'outline-search-reconceal))))) 3850;;;_ > outline-isearch-arrival-business () 3851(defun outline-isearch-arrival-business () 3852 "Do outline business like exposing current point, if necessary. 3853 3854Registers reconcealment requirements in outline-search-reconceal 3855accordingly. 3856 3857Set outline-search-reconceal to nil if current point is not 3858concealed, to value of point if entire topic is concealed, and a 3859list containing point if only the topic body is concealed. 3860 3861This will be used to determine whether outline-hide-current-entry 3862or outline-hide-current-entry-completely will be necessary to 3863restore the prior concealment state." 3864 3865 (if (outline-mode-p) 3866 (setq outline-search-reconceal 3867 (if (outline-hidden-p) 3868 (save-excursion 3869 (if (re-search-backward outline-line-boundary-regexp nil 1) 3870 ;; Nil value means we got to b-o-b - wouldn't need 3871 ;; to advance. 3872 (forward-char 1)) 3873 ; We'll return point or list 3874 ; containing point, depending 3875 ; on concealment state of 3876 ; topic prefix. 3877 (prog1 (if (outline-hidden-p) (point) (list (point))) 3878 ; And reveal the current 3879 ; search target: 3880 (outline-show-entry))))))) 3881;;;_ > outline-isearch-advancing-business () 3882(defun outline-isearch-advancing-business () 3883 "Do outline business like deexposing current point, if necessary. 3884 3885Works according to reconceal state registration." 3886 (if (and (outline-mode-p) outline-search-reconceal) 3887 (save-excursion 3888 (if (listp outline-search-reconceal) 3889 ;; Leave the topic visible: 3890 (progn (goto-char (car outline-search-reconceal)) 3891 (outline-hide-current-entry)) 3892 ;; Rehide the entire topic: 3893 (goto-char outline-search-reconceal) 3894 (outline-hide-current-entry-completely))))) 3895;;;_ > isearch-terminate/outline-provisions () 3896(defun isearch-terminate/outline-provisions () 3897 (interactive) 3898 (if (and (outline-mode-p) outline-enwrap-isearch-mode) 3899 (outline-isearch-advancing-business)) 3900 (let ((outline-search-quitting t) 3901 (outline-search-reconceal nil)) 3902 (real-isearch-terminate))) 3903;;;_ > isearch-done/outline-provisions () 3904(defun isearch-done/outline-provisions (&optional nopush) 3905 (interactive) 3906 (if (and (outline-mode-p) outline-enwrap-isearch-mode) 3907 (progn (if (and outline-search-reconceal 3908 (not (listp outline-search-reconceal))) 3909 ;; The topic was concealed - reveal it, its siblings, 3910 ;; and any ancestors that are still concealed: 3911 (save-excursion 3912 (message "(exposing destination)")(sit-for 0) 3913 (outline-goto-prefix) 3914 ; There may be a closed blank 3915 ; line between prior and 3916 ; current topic that would be 3917 ; missed - provide for it: 3918 (if (not (bobp)) 3919 (progn (forward-char -1) ; newline 3920 (if (eq ?\r (preceding-char)) 3921 (outline-flag-region (1- (point)) 3922 (point) 3923 ?\n)) 3924 (forward-char 1))) 3925 ; Goto parent 3926 (outline-ascend-to-depth (1- (outline-recent-depth))) 3927 (outline-show-children))) 3928 (if (and (boundp 'outline-search-quitting) 3929 outline-search-quitting) 3930 nil 3931 ; We're concluding abort: 3932 (outline-isearch-arrival-business) 3933 (outline-show-children)))) 3934 (if nopush 3935 ;; isearch-done in newer version of isearch mode takes arg: 3936 (real-isearch-done nopush) 3937 (real-isearch-done))) 3938;;;_ > isearch-update/outline-provisions () 3939(defun isearch-update/outline-provisions () 3940 "Wrapper dynamically adjusts isearch target exposure. 3941 3942Appropriately exposes and reconceals hidden outline portions, as 3943necessary, in the course of searching." 3944 (if (not (and (outline-mode-p) outline-enwrap-isearch-mode)) 3945 ;; Just do the plain business: 3946 (real-isearch-update) 3947 3948 ;; Ah - provide for outline conditions: 3949 (outline-isearch-advancing-business) 3950 (real-isearch-update) 3951 (cond (isearch-success (outline-isearch-arrival-business)) 3952 ((not isearch-success) (outline-isearch-advancing-business))))) 3953 3954;;;_ #8 Copying and printing 3955 3956;;;_ - Copy exposed 3957;;;_ > outline-insert-listified (depth prefix bullet text) 3958(defun outline-insert-listified (depth prefix bullet text) 3959 "Insert contents of listified outline portion in current buffer." 3960 (insert-string (concat (if (> depth 1) prefix "") 3961 (make-string (1- depth) ?\ ) 3962 bullet)) 3963 (while text 3964 (insert-string (car text)) 3965 (if (setq text (cdr text)) 3966 (insert-string "\n"))) 3967 (insert-string "\n")) 3968;;;_ > outline-copy-exposed (arg &optional tobuf) 3969(defun outline-copy-exposed (arg &optional tobuf) 3970 "Duplicate exposed portions of current topic to another buffer. 3971 3972Other buffer has current buffers' name with \" exposed\" appended to it. 3973 3974With repeat count, copy the exposed portions of entire buffer." 3975 3976 (interactive "P") 3977 (if (not tobuf) 3978 (setq tobuf (get-buffer-create (concat "*" (buffer-name) " exposed*")))) 3979 (let* ((start-pt (point)) 3980 (beg (if arg (point-min) (outline-back-to-current-heading))) 3981 (end (if arg (point-max) (outline-end-of-current-subtree))) 3982 (buf (current-buffer))) 3983 (save-excursion (set-buffer tobuf)(erase-buffer)) 3984 (outline-process-exposed 'outline-insert-listified 3985 beg 3986 end 3987 (current-buffer) 3988 tobuf) 3989 (goto-char (point-min)) 3990 (pop-to-buffer buf) 3991 (goto-char start-pt))) 3992 3993;;;_ - LaTeX formatting 3994;;;_ > outline-latex-verb-quote (str &optional flow) 3995(defun outline-latex-verb-quote (str &optional flow) 3996 "Return copy of STRING for literal reproduction across latex processing. 3997Expresses the original characters \(including carriage returns) of the 3998string across latex processing." 3999 (mapconcat '(lambda (char) 4000 ;;;mess: (cond ((memq char '(?"" ?$ ?% ?# ?& ?- ?" ?` ?^ ?- ?*));;;")))) 4001 (cond ((memq char '(?\\ ?$ ?% ?# ?& ?{ ?} ?_ ?^ ?- ?*)) 4002 (concat "\\char" (number-to-string char) "{}")) 4003 ((= char ?\n) "\\\\") 4004 (t (char-to-string char)))) 4005 str 4006 "")) 4007;;;_ > outline-latex-verbatim-quote-curr-line () 4008(defun outline-latex-verbatim-quote-curr-line () 4009 "Express line for exact \(literal\) representation across latex processing. 4010 4011Adjust line contents so it is unaltered \(from the original line) 4012across latex processing, within the context of a 'verbatim' 4013environment. Leaves point at the end of the line." 4014 (beginning-of-line) 4015 (let ((beg (point)) 4016 (end (progn (end-of-line)(point)))) 4017 (goto-char beg) 4018 (while (re-search-forward "\\\\" 4019 ;;"\\\\\\|\\{\\|\\}\\|\\_\\|\\$\\|\\\"\\|\\&\\|\\^\\|\\-\\|\\*\\|#" 4020 end ; bounded by end-of-line 4021 1) ; no matches, move to end & return nil 4022 (goto-char (match-beginning 0)) 4023 (insert-string "\\") 4024 (setq end (1+ end)) 4025 (goto-char (1+ (match-end 0)))))) 4026;;;_ > outline-insert-latex-header (buf) 4027(defun outline-insert-latex-header (buf) 4028 "Insert initial latex commands at point in BUFFER." 4029 ;; Much of this is being derived from the stuff in appendix of E in 4030 ;; the TeXBook, pg 421. 4031 (set-buffer buf) 4032 (let ((doc-style (format "\n\\documentstyle{%s}\n" 4033 "report")) 4034 (page-numbering (if outline-number-pages 4035 "\\pagestyle{empty}\n" 4036 "")) 4037 (linesdef (concat "\\def\\beginlines{" 4038 "\\par\\begingroup\\nobreak\\medskip" 4039 "\\parindent=0pt\n" 4040 " \\kern1pt\\nobreak \\obeylines \\obeyspaces " 4041 "\\everypar{\\strut}}\n" 4042 "\\def\\endlines{" 4043 "\\kern1pt\\endgroup\\medbreak\\noindent}\n")) 4044 (titlecmd (format "\\newcommand{\\titlecmd}[1]{{%s #1}}\n" 4045 outline-title-style)) 4046 (labelcmd (format "\\newcommand{\\labelcmd}[1]{{%s #1}}\n" 4047 outline-label-style)) 4048 (headlinecmd (format "\\newcommand{\\headlinecmd}[1]{{%s #1}}\n" 4049 outline-head-line-style)) 4050 (bodylinecmd (format "\\newcommand{\\bodylinecmd}[1]{{%s #1}}\n" 4051 outline-body-line-style)) 4052 (setlength (format "%s%s%s%s" 4053 "\\newlength{\\stepsize}\n" 4054 "\\setlength{\\stepsize}{" 4055 outline-indent 4056 "}\n")) 4057 (oneheadline (format "%s%s%s%s%s%s%s" 4058 "\\newcommand{\\OneHeadLine}[3]{%\n" 4059 "\\noindent%\n" 4060 "\\hspace*{#2\\stepsize}%\n" 4061 "\\labelcmd{#1}\\hspace*{.2cm}" 4062 "\\headlinecmd{#3}\\\\[" 4063 outline-line-skip 4064 "]\n}\n")) 4065 (onebodyline (format "%s%s%s%s%s%s" 4066 "\\newcommand{\\OneBodyLine}[2]{%\n" 4067 "\\noindent%\n" 4068 "\\hspace*{#1\\stepsize}%\n" 4069 "\\bodylinecmd{#2}\\\\[" 4070 outline-line-skip 4071 "]\n}\n")) 4072 (begindoc "\\begin{document}\n\\begin{center}\n") 4073 (title (format "%s%s%s%s" 4074 "\\titlecmd{" 4075 (outline-latex-verb-quote (if outline-title 4076 (condition-case err 4077 (eval outline-title) 4078 (error "<unnamed buffer>")) 4079 "Unnamed Outline")) 4080 "}\n" 4081 "\\end{center}\n\n")) 4082 (hsize "\\hsize = 7.5 true in\n") 4083 (hoffset "\\hoffset = -1.5 true in\n") 4084 (vspace "\\vspace{.1cm}\n\n")) 4085 (insert (concat doc-style 4086 page-numbering 4087 titlecmd 4088 labelcmd 4089 headlinecmd 4090 bodylinecmd 4091 setlength 4092 oneheadline 4093 onebodyline 4094 begindoc 4095 title 4096 hsize 4097 hoffset 4098 vspace) 4099 ))) 4100;;;_ > outline-insert-latex-trailer (buf) 4101(defun outline-insert-latex-trailer (buf) 4102 "Insert concluding latex commands at point in BUFFER." 4103 (set-buffer buf) 4104 (insert "\n\\end{document}\n")) 4105;;;_ > outline-latexify-one-item (depth prefix bullet text) 4106(defun outline-latexify-one-item (depth prefix bullet text) 4107 "Insert LaTeX commands for formatting one outline item. 4108 4109Args are the topics' numeric DEPTH, the header PREFIX lead string, the 4110BULLET string, and a list of TEXT strings for the body." 4111 (let* ((head-line (if text (car text))) 4112 (body-lines (cdr text)) 4113 (curr-line) 4114 body-content bop) 4115 ; Do the head line: 4116 (insert-string (concat "\\OneHeadLine{\\verb\1 " 4117 (outline-latex-verb-quote bullet) 4118 "\1}{" 4119 depth 4120 "}{\\verb\1 " 4121 (if head-line 4122 (outline-latex-verb-quote head-line) 4123 "") 4124 "\1}\n")) 4125 (if (not body-lines) 4126 nil 4127 ;;(insert-string "\\beginlines\n") 4128 (insert-string "\\begin{verbatim}\n") 4129 (while body-lines 4130 (setq curr-line (car body-lines)) 4131 (if (and (not body-content) 4132 (not (string-match "^\\s-*$" curr-line))) 4133 (setq body-content t)) 4134 ; Mangle any occurrences of 4135 ; "\end{verbatim}" in text, 4136 ; it's special: 4137 (if (and body-content 4138 (setq bop (string-match "\\end{verbatim}" curr-line))) 4139 (setq curr-line (concat (substring curr-line 0 bop) 4140 ">" 4141 (substring curr-line bop)))) 4142 ;;(insert-string "|" (car body-lines) "|") 4143 (insert-string curr-line) 4144 (outline-latex-verbatim-quote-curr-line) 4145 (insert-string "\n") 4146 (setq body-lines (cdr body-lines))) 4147 (if body-content 4148 (setq body-content nil) 4149 (forward-char -1) 4150 (insert-string "\\ ") 4151 (forward-char 1)) 4152 ;;(insert-string "\\endlines\n") 4153 (insert-string "\\end{verbatim}\n") 4154 ))) 4155;;;_ > outline-latexify-exposed (arg &optional tobuf) 4156(defun outline-latexify-exposed (arg &optional tobuf) 4157 "Format current topic's exposed portions to TOBUF for latex processing. 4158TOBUF defaults to a buffer named the same as the current buffer, but 4159with \"*\" prepended and \" latex-formed*\" appended. 4160 4161With repeat count, copy the exposed portions of entire buffer." 4162 4163 (interactive "P") 4164 (if (not tobuf) 4165 (setq tobuf 4166 (get-buffer-create (concat "*" (buffer-name) " latexified*")))) 4167 (let* ((start-pt (point)) 4168 (beg (if arg (point-min) (outline-back-to-current-heading))) 4169 (end (if arg (point-max) (outline-end-of-current-subtree))) 4170 (buf (current-buffer))) 4171 (set-buffer tobuf) 4172 (erase-buffer) 4173 (outline-insert-latex-header tobuf) 4174 (goto-char (point-max)) 4175 (outline-process-exposed 'outline-latexify-one-item 4176 beg 4177 end 4178 buf 4179 tobuf) 4180 (goto-char (point-max)) 4181 (outline-insert-latex-trailer tobuf) 4182 (goto-char (point-min)) 4183 (pop-to-buffer buf) 4184 (goto-char start-pt))) 4185 4186;;;_ #9 miscellaneous 4187;;;_ > outline-mark-topic () 4188(defun outline-mark-topic () 4189 "Put the region around topic currently containing point." 4190 (interactive) 4191 (beginning-of-line) 4192 (outline-goto-prefix) 4193 (push-mark (point)) 4194 (outline-end-of-current-subtree) 4195 (exchange-point-and-mark)) 4196;;;_ > outlineify-sticky () 4197;; outlinify-sticky is correct spelling; provide this alias for sticklers: 4198(defalias 'outlinify-sticky 'outlineify-sticky) 4199(defun outlineify-sticky (&optional arg) 4200 "Activate outline mode and establish file var so it is started subseqently. 4201 4202See doc-string for `outline-layout' and `outline-init' for details on 4203setup for auto-startup." 4204 4205 (interactive "P") 4206 4207 (outline-mode t) 4208 4209 (save-excursion 4210 (goto-char (point-min)) 4211 (if (looking-at outline-regexp) 4212 t 4213 (outline-open-topic 2) 4214 (insert-string (concat "Dummy outline topic header - see" 4215 "`outline-mode' docstring for info.")) 4216 (next-line 1) 4217 (goto-char (point-max)) 4218 (next-line 1) 4219 (outline-open-topic 0) 4220 (insert-string "Local emacs vars.\n") 4221 (outline-open-topic 1) 4222 (insert-string "(`outline-layout' is for allout.el outline-mode)\n") 4223 (outline-open-topic 0) 4224 (insert-string "Local variables:\n") 4225 (outline-open-topic 0) 4226 (insert-string (format "outline-layout: %s\n" 4227 (or outline-layout 4228 '(1 : 0)))) 4229 (outline-open-topic 0) 4230 (insert-string "End:\n")))) 4231;;;_ > solicit-char-in-string (prompt string &optional do-defaulting) 4232(defun solicit-char-in-string (prompt string &optional do-defaulting) 4233 "Solicit (with first arg PROMPT) choice of a character from string STRING. 4234 4235Optional arg DO-DEFAULTING indicates to accept empty input (CR)." 4236 4237 (let ((new-prompt prompt) 4238 got) 4239 4240 (while (not got) 4241 (message "%s" new-prompt) 4242 4243 ;; We do our own reading here, so we can circumvent, eg, special 4244 ;; treatment for '?' character. (Might oughta change minibuffer 4245 ;; keymap instead, oh well.) 4246 (setq got 4247 (char-to-string (let ((cursor-in-echo-area nil)) (read-char)))) 4248 4249 (if (null (string-match (regexp-quote got) string)) 4250 (if (and do-defaulting (string= got "\^M")) 4251 ;; We're defaulting, return null string to indicate that: 4252 (setq got "") 4253 ;; Failed match and not defaulting, 4254 ;; set the prompt to give feedback, 4255 (setq new-prompt (concat prompt 4256 got 4257 " ...pick from: " 4258 string 4259 "")) 4260 ;; and set loop to try again: 4261 (setq got nil)) 4262 ;; Got a match - give feedback: 4263 (message ""))) 4264 ;; got something out of loop - return it: 4265 got) 4266 ) 4267;;;_ > regexp-sans-escapes (string) 4268(defun regexp-sans-escapes (regexp &optional successive-backslashes) 4269 "Return a copy of REGEXP with all character escapes stripped out. 4270 4271Representations of actual backslashes - '\\\\\\\\' - are left as a 4272single backslash. 4273 4274Optional arg SUCCESSIVE-BACKSLASHES is used internally for recursion." 4275 4276 (if (string= regexp "") 4277 "" 4278 ;; Set successive-backslashes to number if current char is 4279 ;; backslash, or else to nil: 4280 (setq successive-backslashes 4281 (if (= (aref regexp 0) ?\\) 4282 (if successive-backslashes (1+ successive-backslashes) 1) 4283 nil)) 4284 (if (or (not successive-backslashes) (= 2 successive-backslashes)) 4285 ;; Include first char: 4286 (concat (substring regexp 0 1) 4287 (regexp-sans-escapes (substring regexp 1))) 4288 ;; Exclude first char, but maintain count: 4289 (regexp-sans-escapes (substring regexp 1) successive-backslashes)))) 4290;;;_ - add-hook definition for divergent emacsen 4291;;;_ > add-hook (hook function &optional append) 4292(if (not (fboundp 'add-hook)) 4293 (defun add-hook (hook function &optional append) 4294 "Add to the value of HOOK the function FUNCTION unless already present. 4295\(It becomes the first hook on the list unless optional APPEND is non-nil, in 4296which case it becomes the last). HOOK should be a symbol, and FUNCTION may be 4297any valid function. HOOK's value should be a list of functions, not a single 4298function. If HOOK is void, it is first set to nil." 4299 (or (boundp hook) (set hook nil)) 4300 (or (if (consp function) 4301 ;; Clever way to tell whether a given lambda-expression 4302 ;; is equal to anything in the hook. 4303 (let ((tail (assoc (cdr function) (symbol-value hook)))) 4304 (equal function tail)) 4305 (memq function (symbol-value hook))) 4306 (set hook 4307 (if append 4308 (nconc (symbol-value hook) (list function)) 4309 (cons function (symbol-value hook))))))) 4310 4311;;;_ #10 Under development 4312;;;_ > outline-bullet-isearch (&optional bullet) 4313(defun outline-bullet-isearch (&optional bullet) 4314 "Isearch \(regexp\) for topic with bullet BULLET." 4315 (interactive) 4316 (if (not bullet) 4317 (setq bullet (solicit-char-in-string 4318 "ISearch for topic with bullet: " 4319 (regexp-sans-escapes outline-bullets-string)))) 4320 4321 (let ((isearch-regexp t) 4322 (isearch-string (concat "^" 4323 outline-header-prefix 4324 "[ \t]*" 4325 bullet))) 4326 (isearch-repeat 'forward) 4327 (isearch-mode t))) 4328;;;_ ? Re hooking up with isearch - use isearch-op-fun rather than 4329;;; wrapping the isearch functions. 4330 4331;;;_* Local emacs vars. 4332;;; The following `outline-layout' local variable setting: 4333;;; - closes all topics from the first topic to just before the third-to-last, 4334;;; - shows the children of the third to last (config vars) 4335;;; - and the second to last (code section), 4336;;; - and closes the last topic (this local-variables section). 4337;;;Local variables: 4338;;;outline-layout: (0 : -1 -1 0) 4339;;;End: 4340 4341;; allout.el ends here 4342