X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/23e62b22f520c784c6abee5394f56b1de5941214..8d118843104bea1dabc87d038a27a7bed3bd9288:/lisp/allout.el diff --git a/lisp/allout.el b/lisp/allout.el index 1dd8757b30..3695929bce 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -1,276 +1,492 @@ -;;;_* Allout - An extensive outline-mode for Emacs. -;;; Note - the lines beginning with ';;;_' are outline topic headers. -;;; Load this file (or 'eval-current-buffer') and revisit the -;;; file to give it a whirl. +;;;_* allout.el - Extensive outline mode for use alone and with other modes. -;;;_ + Provide -(provide 'outline) +;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. -;;;_ + Package Identification Stuff +;; Author: Ken Manheimer +;; Maintainer: Ken Manheimer +;; Created: Dec 1991 - first release to usenet +;; Version: Id: allout.el,v 4.3 1994/05/12 17:43:08 klm Exp || +;; Keywords: outline mode -;;;_ - Author: Ken Manheimer -;;;_ - Maintainer: Ken Manheimer -;;;_ - Created: Dec 1991 - first release to usenet -;;;_ - Version: $Id: allout.el,v 1.3 1993/06/09 11:51:08 jimb Exp $|| -;;;_ - Keywords: outline mode +;; This file is part of GNU Emacs. -;;;_ - LCD Archive Entry +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. -;; LCD Archive Entry: -;; allout|Ken Manheimer|klm@nist.gov -;; |A more thorough outline-mode -;; |27-May-1993|$Id: allout.el,v 1.3 1993/06/09 11:51:08 jimb Exp $|| +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;;_* Commentary: + +;; Allout outline mode provides extensive outline formatting and +;; manipulation capabilities, subsuming and well beyond that of +;; standard emacs outline mode. It is specifically aimed at +;; supporting outline structuring and manipulation of syntax- +;; sensitive text, eg programming languages. (For an example, see the +;; allout code itself, which is organized in outline structure.) +;; +;; It also includes such things as topic-oriented repositioning, cut, and +;; paste; integral outline exposure-layout; incremental search with +;; dynamic exposure/conceament of concealed text; automatic topic-number +;; maintenance; and many other features. +;; +;; See the docstring of the variables `outline-layout' and +;; `outline-auto-activation' for details on automatic activation of +;; allout outline-mode as a minor mode. (It has changed since allout +;; 3.x, for those of you that depend on the old method.) +;; +;; Note - the lines beginning with ';;;_' are outline topic headers. +;; Just 'ESC-x eval-current-buffer' to give it a whirl. -;;;_ - Description -;; A full-fledged outline mode, based on the original rudimentary -;; GNU emacs outline functionality. +;;Ken Manheimer 301 975-3539 +;;ken.manheimer@nist.gov FAX: 301 963-9137 ;; -;; Ken Manheimer Nat'l Inst of Standards and Technology -;; klm@nist.gov (301)975-3539 (Formerly Nat'l Bureau of Standards) -;; NIST Shared File Service Manager and Developer +;;Computer Systems and Communications Division +;; +;; Nat'l Institute of Standards and Technology +;; Technology A151 +;; Gaithersburg, MD 20899 -;;;_ - Copyright -;; Copyright (C) 1992, 1993 Free Software Foundation, Inc. +;;;_* Provide +(provide 'outline) +(provide 'allout) -;; This file is part of GNU Emacs. +;;;_* USER CUSTOMIZATION VARIABLES: -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY. No author or distributor -;; accepts responsibility to anyone for the consequences of using it -;; or for whether it serves any particular purpose or works at all, -;; unless he says so in writing. Refer to the GNU Emacs General Public -;; License for full details. +;;;_ + Layout, Mode, and Topic Header Configuration -;; Everyone is granted permission to copy, modify and redistribute -;; GNU Emacs, but only under the conditions described in the -;; GNU Emacs General Public License. A copy of this license is -;; supposed to have been given to you along with GNU Emacs so you -;; can know your rights and responsibilities. It should be in a -;; file named COPYING. Among other things, the copyright notice -;; and this notice must be preserved on all copies. +;;;_ = outline-auto-activation +(defvar outline-auto-activation nil + "*Regulates auto-activation modality of allout outlines - see `outline-init'. -;;;_ + User Customization variables +Setq-default by `outline-init' to regulate whether or not allout +outline mode is automatically activated when the buffer-specific +variable `outline-layout' is non-nil, and whether or not the layout +dictated by `outline-layout' should be imposed on mode activation. -;;;_ - Topic Header configuration +With value `t', auto-mode-activation and auto-layout are enabled. +\(This also depends on `outline-find-file-hooks' being installed in +`find-file-hooks', which is also done by `outline-init'.) -;;;_ = outline-header-prefix -(defvar outline-header-prefix "." - "* Leading string for greater than level 0 topic headers.") -(make-variable-buffer-local 'outline-header-prefix) +With value `ask', auto-mode-activation is enabled, and endorsement for +performing auto-layout is asked of the user each time. -;;;_ = outline-header-subtraction -(defvar outline-header-subtraction (1- (length outline-header-prefix)) - "* Leading string for greater than level 0 topic headers.") -(make-variable-buffer-local 'outline-header-subtraction) +With value `activate', only auto-mode-activation is enabled, auto- +layout is not. + +With value `nil', neither auto-mode-activation nor auto-layout are +enabled. + +See the docstring for `outline-init' for the proper interface to +this variable.") +;;;_ = outline-layout +(defvar outline-layout nil + "*Layout specification and provisional mode trigger for allout outlines. + +Buffer-specific. -;;;_ = outline-primary-bullet -(defvar outline-primary-bullet "*") ;; Changing this var disables any - ;; backwards compatibility with - ;; the original outline mode. +A list value specifies a default layout for the current buffer, to be +applied upon activation of allout outline-mode. Any non-nil value +will automatically trigger allout outline-mode, provided `outline- +init' has been called to enable it. + +See the docstring for `outline-init' for details on setting up for +auto-mode-activation, and for `outline-expose-topic' for the format of +the layout specification. + +You can associate a particular outline layout with a file by setting +this var via the file's local variables. For example, the following +lines at the bottom of an elisp file: + +;;;Local variables: +;;;outline-layout: \(0 : -1 -1 0\) +;;;End: + +will, modulo the above-mentioned conditions, cause the mode to be +activated when the file is visited, followed by the equivalent of +`\(outline-expose-topic 0 : -1 -1 0\)'. \(This is the layout used for +the allout.el, itself.) + +Also, allout's mode-specific provisions will make topic prefixes +default to the comment-start string, if any, of the language of the +file. This is modulo the setting of `outline-use-mode-specific- +leader', which see.") +(make-variable-buffer-local 'outline-layout) + +;;;_ = outline-header-prefix +(defvar outline-header-prefix "." + "*Leading string which helps distinguish topic headers. + +Outline topic header lines are identified by a leading topic +header prefix, which mostly have the value of this var at their front. +\(Level 1 topics are exceptions. They consist of only a single +character, which is typically set to the outline-primary-bullet. Many +outlines start at level 2 to avoid this discrepancy.") +(make-variable-buffer-local 'outline-header-prefix) +;;;_ = outline-primary-bullet +(defvar outline-primary-bullet "*" + "Bullet used for top-level outline topics. + +Outline topic header lines are identified by a leading topic header +prefix, which is concluded by bullets that includes the value of this +var and the respective outline-*-bullets-string vars. + +The value of an asterisk ('*') provides for backwards compatability +with the original emacs outline mode. See outline-plain-bullets-string +and outline-distinctive-bullets-string for the range of available +bullets.") (make-variable-buffer-local 'outline-primary-bullet) +;;;_ = outline-plain-bullets-string +(defvar outline-plain-bullets-string (concat outline-primary-bullet + "+-:.;,") + "*The bullets normally used in outline topic prefixes. -;;;_ = outline-plain-bullets-string -(defvar outline-plain-bullets-string "" - "* The bullets normally used in outline topic prefixes. See - 'outline-distinctive-bullets-string' for the other kind of - bullets. +See 'outline-distinctive-bullets-string' for the other kind of +bullets. - DO NOT include the close-square-bracket, ']', among any bullets. +DO NOT include the close-square-bracket, ']', as a bullet. - You must run 'set-outline-regexp' in order for changes to the - value of this var to effect outline-mode operation.") -(setq outline-plain-bullets-string (concat outline-primary-bullet - "+-:.;,")) +Outline mode has to be reactivated in order for changes to the value +of this var to take effect.") (make-variable-buffer-local 'outline-plain-bullets-string) +;;;_ = outline-distinctive-bullets-string +(defvar outline-distinctive-bullets-string "=>([{}&!?#%\"X@$~\\" + "*Persistent outline header bullets used to distinguish special topics. -;;;_ = outline-distinctive-bullets-string -(defvar outline-distinctive-bullets-string "" - "* The bullets used for distinguishing outline topics. These - bullets are not offered among the regular rotation, and are not - changed when automatically rebulleting, as when shifting the - level of a topic. See 'outline-plain-bullets-string' for the - other kind of bullets. +These bullets are not offered among the regular, level-specific +rotation, and are not altered by automatic rebulleting, as when +shifting the level of a topic. See `outline-plain-bullets-string' for +the selection of alternating bullets. - DO NOT include the close-square-bracket, ']', among any bullets. +You must run 'set-outline-regexp' in order for changes +to the value of this var to effect outline-mode operation. - You must run 'set-outline-regexp' in order for changes - to the value of this var to effect outline-mode operation.") -(setq outline-distinctive-bullets-string "=>([{}&!?#%\"X@$~") +DO NOT include the close-square-bracket, ']', on either of the bullet +strings.") (make-variable-buffer-local 'outline-distinctive-bullets-string) -;;;_ > outline-numbered-bullet () -(defvar outline-numbered-bullet () - "* Bullet signifying outline prefixes which are to be numbered. - Leave it nil if you don't want any numbering, or set it to a - string with the bullet you want to be used.") -(setq outline-numbered-bullet "#") -(make-variable-buffer-local 'outline-numbered-bullet) +;;;_ = outline-use-mode-specific-leader +(defvar outline-use-mode-specific-leader t + "*When non-nil, use mode-specific topic-header prefixes. -;;;_ = outline-file-xref-bullet -(defvar outline-file-xref-bullet "@" - "* Set this var to the bullet you want to use for file cross-references. - Set it 'nil' if you want to inhibit this capability.") +Allout outline mode will use the mode-specific `outline-mode-leaders' +and/or comment-start string, if any, to lead the topic prefix string, +so topic headers look like comments in the programming language. -;;;_ - Miscellaneous customization +String values are used as they stand. -;;;_ = outline-stylish-prefixes -(defvar outline-stylish-prefixes t - "*A true value for this var makes the topic-prefix creation and modification - functions vary the prefix bullet char according to level. Otherwise, only - asterisks ('*') and distinctive bullets are used. - - This is how an outline can look with stylish prefixes: - - * Top level - .* A topic - . + One level 3 subtopic - . . One level 4 subtopic - . + Another level 3 subtopic - . . A level 4 subtopic - . #2 A distinguished, numbered level 4 subtopic - . ! A distinguished ('!') level 4 subtopic - . #4 Another numbered level 4 subtopic - - This would be an outline with stylish prefixes inhibited: - - * Top level - .* A topic - .! A distinctive (but measly) subtopic - . * A sub-subtopic - no bullets from outline-plain-bullets-string but '*' - - Stylish and constant prefixes (as well as old-style prefixes) are - always respected by the topic maneuvering functions, regardless of - this variable setting. - - The setting of this var is not relevant when outline-old-style-prefixes - is t.") -(make-variable-buffer-local 'outline-stylish-prefixes) +Value `t' means to first check for assoc value in `outline-mode-leaders' +alist, then use comment-start string, if any, then use default \(`.'). +\(See note about use of comment-start strings, below.\) -;;;_ = outline-old-style-prefixes -(defvar outline-old-style-prefixes nil - "*Setting this var causes the topic-prefix creation and modification - functions to make only asterix-padded prefixes, so they look exactly - like the old style prefixes. +Set to the symbol for either of `outline-mode-leaders' or +`comment-start' to use only one of them, respectively. - Both old and new style prefixes are always respected by the topic - maneuvering functions.") -(make-variable-buffer-local 'outline-old-style-prefixes) +Value `nil' means to always use the default \(`.'\). -;;;_ = outline-enwrap-isearch-mode - ; Spiffy dynamic-exposure - ; during searches requires - ; Dan LaLiberte's isearch-mode: -(defvar outline-enwrap-isearch-mode "isearch-mode.el" - "* Set this var to the name of the (non-compiled) elisp code for - isearch-mode, if you have Dan LaLiberte's 'isearch-mode' - stuff and want isearches to reveal hidden stuff encountered in the - course of a search, and reconceal it if you go past. Set it nil if - you don't have the package, or don't want to use this feature.") - -;;;_ = outline-use-hanging-indents -(defvar outline-use-hanging-indents t - "* Set this var non-nil if you have Kyle E Jones' filladapt stuff, - and you want outline to fill topics as hanging indents to the - bullets.") -(make-variable-buffer-local 'outline-use-hanging-indents) +comment-start strings that do not end in spaces are tripled, and an +'_' underscore is tacked on the end, to distinguish them from regular +comment strings. comment-start strings that do end in spaces are not +tripled, but an underscore is substituted for the space. \[This +presumes that the space is for appearance, not comment syntax. You +can use `outline-mode-leaders' to override this behavior, when +incorrect.\]") +;;;_ = outline-mode-leaders +(defvar outline-mode-leaders '() + "Specific outline-prefix leading strings per major modes. -;;;_ = outline-reindent-bodies -(defvar outline-reindent-bodies t - "* Set this var non-nil if you want topic depth adjustments to - reindent hanging bodies (ie, bodies lines indented to beginning of - heading text). The performance hit is small. +Entries will be used in the stead (or lieu) of mode-specific +comment-start strings. See also `outline-use-mode-specific-leader'. - Avoid this strenuously when using outline mode on program code. - It's great for text, though.") -(make-variable-buffer-local 'outline-reindent-bodies) +If you're constructing a string that will comment-out outline +structuring so it can be included in program code, append an extra +character, like an \"_\" underscore, to distinguish the lead string +from regular comments that start at bol.") + +;;;_ = outline-old-style-prefixes +(defvar outline-old-style-prefixes nil + "*When non-nil, use only old-and-crusty outline-mode '*' topic prefixes. + +Non-nil restricts the topic creation and modification +functions to asterix-padded prefixes, so they look exactly +like the original emacs-outline style prefixes. + +Whatever the setting of this variable, both old and new style prefixes +are always respected by the topic maneuvering functions.") +(make-variable-buffer-local 'outline-old-style-prefixes) +;;;_ = outline-stylish-prefixes - alternating bullets +(defvar outline-stylish-prefixes t + "*Do fancy stuff with topic prefix bullets according to level, etc. + +Non-nil enables topic creation, modification, and repositioning +functions to vary the topic bullet char (the char that marks the topic +depth) just preceding the start of the topic text) according to level. +Otherwise, only asterisks ('*') and distinctive bullets are used. + +This is how an outline can look (but sans indentation) with stylish +prefixes: + + * Top level + .* A topic + . + One level 3 subtopic + . . One level 4 subtopic + . . A second 4 subtopic + . + Another level 3 subtopic + . #1 A numbered level 4 subtopic + . #2 Another + . ! Another level 4 subtopic with a different distinctive bullet + . #4 And another numbered level 4 subtopic + +This would be an outline with stylish prefixes inhibited (but the +numbered and other distinctive bullets retained): + + * Top level + .* A topic + . * One level 3 subtopic + . * One level 4 subtopic + . * A second 4 subtopic + . * Another level 3 subtopic + . #1 A numbered level 4 subtopic + . #2 Another + . ! Another level 4 subtopic with a different distinctive bullet + . #4 And another numbered level 4 subtopic + +Stylish and constant prefixes (as well as old-style prefixes) are +always respected by the topic maneuvering functions, regardless of +this variable setting. + +The setting of this var is not relevant when outline-old-style-prefixes +is non-nil.") +(make-variable-buffer-local 'outline-stylish-prefixes) + +;;;_ = outline-numbered-bullet +(defvar outline-numbered-bullet "#" + "*String designating bullet of topics that have auto-numbering; nil for none. -;;;_ = outline-mode-keys -;;; You have to restart outline-mode - '(outline-mode t)' - to have -;;; any changes take hold. -(defvar outline-mode-keys () - "Assoc list of outline-mode-keybindings, for common reference in setting -up major and minor-mode keybindings.") -(setq outline-mode-keys +Topics having this bullet have automatic maintainence of a sibling +sequence-number tacked on, just after the bullet. Conventionally set +to \"#\", you can set it to a bullet of your choice. A nil value +disables numbering maintainence.") +(make-variable-buffer-local 'outline-numbered-bullet) +;;;_ = outline-file-xref-bullet +(defvar outline-file-xref-bullet "@" + "*Bullet signifying file cross-references, for `outline-resolve-xref'. + +Set this var to the bullet you want to use for file cross-references. +Set it 'nil' if you want to inhibit this capability.") + +;;;_ + LaTeX formatting +;;;_ - outline-number-pages +(defvar outline-number-pages nil + "*Non-nil turns on page numbering for LaTeX formatting of an outline.") +;;;_ - outline-label-style +(defvar outline-label-style "\\large\\bf" + "*Font and size of labels for LaTeX formatting of an outline.") +;;;_ - outline-head-line-style +(defvar outline-head-line-style "\\large\\sl " + "*Font and size of entries for LaTeX formatting of an outline.") +;;;_ - outline-body-line-style +(defvar outline-body-line-style " " + "*Font and size of entries for LaTeX formatting of an outline.") +;;;_ - outline-title-style +(defvar outline-title-style "\\Large\\bf" + "*Font and size of titles for LaTeX formatting of an outline.") +;;;_ - outline-title +(defvar outline-title '(or buffer-file-name (current-buffer-name)) + "*Expression to be evaluated to determine the title for LaTeX +formatted copy.") +;;;_ - outline-line-skip +(defvar outline-line-skip ".05cm" + "*Space between lines for LaTeX formatting of an outline.") +;;;_ - outline-indent +(defvar outline-indent ".3cm" + "*LaTeX formatted depth-indent spacing.") + +;;;_ + Miscellaneous customization + +;;;_ = outline-keybindings-list +;;; You have to reactivate outline-mode - '(outline-mode t)' - to +;;; institute changes to this var. +(defvar outline-keybindings-list () + "*List of outline-mode key / function bindings. + +These bindings will be locally bound on the outline-mode-map. The +keys will be prefixed by outline-command-prefix, unless the cell +contains a third, no-nil element, in which case the initial string +will be used as is.") +(setq outline-keybindings-list '( ; Motion commands: - ("\C-c\C-n" outline-next-visible-heading) - ("\C-c\C-p" outline-previous-visible-heading) - ("\C-c\C-u" outline-up-current-level) - ("\C-c\C-f" outline-forward-current-level) - ("\C-c\C-b" outline-backward-current-level) - ("\C-c\C-a" outline-beginning-of-current-entry) - ("\C-c\C-e" outline-end-of-current-entry) + ("?t" outline-latexify-exposed) + ("\C-n" outline-next-visible-heading) + ("\C-p" outline-previous-visible-heading) + ("\C-u" outline-up-current-level) + ("\C-f" outline-forward-current-level) + ("\C-b" outline-backward-current-level) + ("\C-a" outline-beginning-of-current-entry) + ("\C-e" outline-end-of-current-entry) + ;;("\C-n" outline-next-line-or-topic) + ;;("\C-p" outline-previous-line-or-topic) ; Exposure commands: - ("\C-c\C-i" outline-show-current-children) - ("\C-c\C-s" outline-show-current-subtree) - ("\C-c\C-h" outline-hide-current-subtree) - ("\C-c\C-o" outline-show-current-entry) - ("\C-c!" outline-show-all) + ("\C-i" outline-show-children) + ("\C-s" outline-show-current-subtree) + ("\C-h" outline-hide-current-subtree) + ("\C-o" outline-show-current-entry) + ("!" outline-show-all) ; Alteration commands: - ("\C-c " open-sibtopic) - ("\C-c." open-subtopic) - ("\C-c," open-supertopic) - ("\C-c'" outline-shift-in) - ("\C-c>" outline-shift-in) - ("\C-c<" outline-shift-out) - ("\C-c\C-m" outline-rebullet-topic) - ("\C-cb" outline-rebullet-current-heading) - ("\C-c#" outline-number-siblings) - ("\C-k" outline-kill-line) - ("\C-y" outline-yank) - ("\M-y" outline-yank-pop) - ("\C-c\C-k" outline-kill-topic) + (" " outline-open-sibtopic) + ("." outline-open-subtopic) + ("," outline-open-supertopic) + ("'" outline-shift-in) + (">" outline-shift-in) + ("<" outline-shift-out) + ("\C-m" outline-rebullet-topic) + ("b" outline-rebullet-current-heading) + ("#" outline-number-siblings) + ("\C-k" outline-kill-line t) + ("\C-y" outline-yank t) + ("\M-y" outline-yank-pop t) + ("\C-k" outline-kill-topic) ; Miscellaneous commands: - ("\C-c@" outline-resolve-xref) - ("\C-cc" outline-copy-exposed))) + ("\C-@" outline-mark-topic) + ("@" outline-resolve-xref) + ("?c" outline-copy-exposed))) + +;;;_ = outline-command-prefix +(defvar outline-command-prefix "\C-c" + "*Key sequence to be used as prefix for outline mode command key bindings.") + +;;;_ = outline-enwrap-isearch-mode +(defvar outline-enwrap-isearch-mode t + "*Set non-nil to enable automatic exposure of concealed isearch targets. + +If non-nil, isearch will expose hidden text encountered in the course +of a search, and to reconceal it if the search is continued past it.") + +;;;_ = outline-use-hanging-indents +(defvar outline-use-hanging-indents t + "*If non-nil, topic body text auto-indent defaults to indent of the header. +Ie, it is indented to be just past the header prefix. This is +relevant mostly for use with indented-text-mode, or other situations +where auto-fill occurs. + +[This feature no longer depends in any way on the 'filladapt.el' +lisp-archive package.]") +(make-variable-buffer-local 'outline-use-hanging-indents) + +;;;_ = outline-reindent-bodies +(defvar outline-reindent-bodies (if outline-use-hanging-indents + 'text) + "*Non-nil enables auto-adjust of topic body hanging indent with depth shifts. -;;;_ + Code - no user customizations below. +When active, topic body lines that are indented even with or beyond +their topic header are reindented to correspond with depth shifts of +the header. -;;;_ #1 Outline Format and Internal Mode Configuration +A value of `t' enables reindent in non-programming-code buffers, ie +those that do not have the variable `comment-start' set. A value of +`force' enables reindent whether or not `comment-start' is set.") -;;;_ : Topic header format -;;;_ = outline-regexp +(make-variable-buffer-local 'outline-reindent-bodies) + +;;;_ = outline-inhibit-protection +(defvar outline-inhibit-protection nil + "*Non-nil disables warnings and confirmation-checks for concealed-text edits. + +Outline mode uses emacs change-triggered functions to detect unruly +changes to concealed regions. Set this var non-nil to disable the +protection, potentially increasing text-entry responsiveness a bit. + +This var takes effect at outline-mode activation, so you may have to +deactivate and then reactivate the mode if you want to toggle the +behavior.") + +;;;_* CODE - no user customizations below. + +;;;_ #1 Internal Outline Formatting and Configuration +;;;_ - Version +;;;_ = outline-version +(defvar outline-version + (let ((rcs-rev "Revision: 4.3")) + (condition-case err + (save-match-data + (string-match "Revision: \\([0-9]+\\.[0-9]+\\)" rcs-rev) + (substring rcs-rev (match-beginning 1) (match-end 1))) + (error rcs-rev))) + "Revision number of currently loaded outline package. \(allout.el)") +;;;_ > outline-version +(defun outline-version (&optional here) + "Return string describing the loaded outline version." + (interactive "P") + (let ((msg (concat "Allout Outline Mode v " outline-version))) + (if here (insert-string msg)) + (message "%s" msg) + msg)) +;;;_ - Topic header format +;;;_ = outline-regexp (defvar outline-regexp "" - "* Regular expression to match the beginning of a heading line. - Any line whose beginning matches this regexp is considered a - heading. This var is set according to the user configuration vars - by set-outline-regexp.") + "*Regular expression to match the beginning of a heading line. + +Any line whose beginning matches this regexp is considered a +heading. This var is set according to the user configuration vars +by set-outline-regexp.") (make-variable-buffer-local 'outline-regexp) -;;;_ = outline-bullets-string +;;;_ = outline-bullets-string (defvar outline-bullets-string "" - " A string dictating the valid set of outline topic bullets. This - var should *not* be set by the user - it is set by 'set-outline-regexp', - and is composed from the elements of 'outline-plain-bullets-string' - and 'outline-distinctive-bullets-string'.") + "A string dictating the valid set of outline topic bullets. + +This var should *not* be set by the user - it is set by 'set-outline-regexp', +and is produced from the elements of 'outline-plain-bullets-string' +and 'outline-distinctive-bullets-string'.") (make-variable-buffer-local 'outline-bullets-string) -;;;_ = outline-line-boundary-regexp +;;;_ = outline-bullets-string-len +(defvar outline-bullets-string-len 0 + "Length of current buffers' outline-plain-bullets-string.") +(make-variable-buffer-local 'outline-bullets-string-len) +;;;_ = outline-line-boundary-regexp (defvar outline-line-boundary-regexp () - " outline-regexp with outline-style beginning of line anchor (ie, - C-j, *or* C-m, for prefixes of hidden topics). This is properly - set when outline-regexp is produced by 'set-outline-regexp', so - that (match-beginning 2) and (match-end 2) delimit the prefix.") + "Outline-regexp with outline-style beginning-of-line anchor. + +(Ie, C-j, *or* C-m, for prefixes of hidden topics). This is properly +set when outline-regexp is produced by 'set-outline-regexp', so +that (match-beginning 2) and (match-end 2) delimit the prefix.") (make-variable-buffer-local 'outline-line-boundary-regexp) -;;;_ = outline-bob-regexp +;;;_ = outline-bob-regexp (defvar outline-bob-regexp () - " Like outline-line-boundary-regexp, this is an outline-regexp for - outline headers at the beginning of the buffer. (match-beginning 2) - and (match-end 2) - delimit the prefix.") -(make-variable-buffer-local 'outline-line-bob-regexp) -;;;_ > outline-reset-header-lead (header-lead) + "Like outline-line-boundary-regexp, for headers at beginning of buffer. +(match-beginning 2) and (match-end 2) delimit the prefix.") +(make-variable-buffer-local 'outline-bob-regexp) +;;;_ = outline-header-subtraction +(defvar outline-header-subtraction (1- (length outline-header-prefix)) + "Outline-header prefix length to subtract when computing topic depth.") +(make-variable-buffer-local 'outline-header-subtraction) +;;;_ = outline-plain-bullets-string-len +(defvar outline-plain-bullets-string-len (length outline-plain-bullets-string) + "Length of outline-plain-bullets-string, updated by set-outline-regexp.") +(make-variable-buffer-local 'outline-plain-bullets-string-len) + + +;;;_ X outline-reset-header-lead (header-lead) (defun outline-reset-header-lead (header-lead) - "* Reset the leading string used to identify topic headers." + "*Reset the leading string used to identify topic headers." (interactive "sNew lead string: ") - ;;() (setq outline-header-prefix header-lead) (setq outline-header-subtraction (1- (length outline-header-prefix))) - (set-outline-regexp) - ) -;;;_ > outline-lead-with-comment-string (header-lead) + (set-outline-regexp)) +;;;_ X outline-lead-with-comment-string (header-lead) (defun outline-lead-with-comment-string (&optional header-lead) - "* Set the topic-header leading string to specified string. Useful - when for encapsulating outline structure in programming language - comments. Returns the leading string." + "*Set the topic-header leading string to specified string. + +Useful when for encapsulating outline structure in programming +language comments. Returns the leading string." (interactive "P") (if (not (stringp header-lead)) @@ -279,10 +495,73 @@ up major and minor-mode keybindings.") (setq outline-reindent-bodies nil) (outline-reset-header-lead header-lead) header-lead) -;;;_ > set-outline-regexp () +;;;_ > outline-infer-header-lead () +(defun outline-infer-header-lead () + "Determine appropriate `outline-header-prefix'. + +Works according to settings of: + + `comment-start' + `outline-header-prefix' (default) + `outline-use-mode-specific-leader' +and `outline-mode-leaders'. + +Apply this via \(re\)activation of `outline-mode', rather than +invoking it directly." + (let* ((use-leader (and (boundp 'outline-use-mode-specific-leader) + (if (or (stringp outline-use-mode-specific-leader) + (memq outline-use-mode-specific-leader + '(outline-mode-leaders + comment-start + t))) + outline-use-mode-specific-leader + ;; Oops - garbled value, equate with effect of 't: + t))) + (leader + (cond + ((not use-leader) nil) + ;; Use the explicitly designated leader: + ((stringp use-leader) use-leader) + (t (or (and (memq use-leader '(t outline-mode-leaders)) + ;; Get it from outline mode leaders? + (cdr (assq major-mode outline-mode-leaders))) + ;; ... didn't get from outline-mode-leaders... + (and (memq use-leader '(t comment-start)) + comment-start + ;; Use comment-start, maybe tripled, and with + ;; underscore: + (concat + (if (string= " " + (substring comment-start + (1- (length comment-start)))) + ;; Use comment-start, sans trailing space: + (substring comment-start 0 -1) + (concat comment-start comment-start comment-start)) + ;; ... and append underscore, whichever: + "_"))))))) + (if (not leader) + nil + (if (string= leader outline-header-prefix) + nil ; no change, nothing to do. + (setq outline-header-prefix leader) + outline-header-prefix)))) +;;;_ > outline-infer-body-reindent () +(defun outline-infer-body-reindent () + "Determine proper setting for `outline-reindent-bodies'. + +Depends on default setting of `outline-reindent-bodies' \(which see) +and presence of setting for `comment-start', to tell whether the +file is programming code." + (if (and outline-reindent-bodies + comment-start + (not (eq 'force outline-reindent-bodies))) + (setq outline-reindent-bodies nil))) +;;;_ > set-outline-regexp () (defun set-outline-regexp () - " Generate proper topic-header regexp form for outline functions, from - outline-plain-bullets-string and outline-distinctive-bullets-string." + "Generate proper topic-header regexp form for outline functions. + +Works with respect to `outline-plain-bullets-string' and +`outline-distinctive-bullets-string'." (interactive) ;; Derive outline-bullets-string from user configured components: @@ -291,6 +570,7 @@ up major and minor-mode keybindings.") 'outline-distinctive-bullets-string)) cur-string cur-len + cur-char cur-char-string index new-string) @@ -326,157 +606,55 @@ up major and minor-mode keybindings.") outline-primary-bullet "+\\|\^l")) (setq outline-line-boundary-regexp - (concat "\\([\C-j\C-m]\\)\\(" outline-regexp "\\)")) + (concat "\\([\n\r]\\)\\(" outline-regexp "\\)")) (setq outline-bob-regexp (concat "\\(\\`\\)\\(" outline-regexp "\\)")) ) - -;;;_ : Key bindings -;;;_ = Generic minor keybindings control -;;;_ ; Stallman's suggestion -(defvar outline-mode-map nil "") - -(if outline-mode-map - nil - (setq outline-mode-map (nconc (make-sparse-keymap) text-mode-map)) - (define-key outline-mode-map "\C-c\C-n" 'outline-next-visible-heading) - (define-key outline-mode-map "\C-c\C-p" 'outline-previous-visible-heading) - (define-key outline-mode-map "\C-c\C-i" 'show-children) - (define-key outline-mode-map "\C-c\C-s" 'show-subtree) - (define-key outline-mode-map "\C-c\C-h" 'hide-subtree) - (define-key outline-mode-map "\C-c\C-u" 'outline-up-heading) - (define-key outline-mode-map "\C-c\C-f" 'outline-forward-same-level) - (define-key outline-mode-map "\C-c\C-b" 'outline-backward-same-level)) - -(defvar outline-minor-mode nil - "Non-nil if using Outline mode as a minor mode of some other mode.") -(make-variable-buffer-local 'outline-minor-mode) -(put 'outline-minor-mode 'permanent-local t) -(setq minor-mode-alist (append minor-mode-alist - (list '(outline-minor-mode " Outl")))) - -(defvar outline-minor-mode-map nil) -(if outline-minor-mode-map - nil - (setq outline-minor-mode-map (make-sparse-keymap)) - (define-key outline-minor-mode-map "\C-c" - (lookup-key outline-mode-map "\C-c"))) - -(or (assq 'outline-minor-mode minor-mode-map-alist) - (setq minor-mode-map-alist - (cons (cons 'outline-minor-mode outline-minor-mode-map) - minor-mode-map-alist))) - -(defun outline-minor-mode (&optional arg) - "Toggle Outline minor mode. -With arg, turn Outline minor mode on if arg is positive, off otherwise. -See the command `outline-mode' for more information on this mode." - (interactive "P") - (setq outline-minor-mode - (if (null arg) (not outline-minor-mode) - (> (prefix-numeric-value arg) 0))) - (if outline-minor-mode - (progn - (setq selective-display t) - (run-hooks 'outline-minor-mode-hook)) - (setq selective-display nil))) -;;;_ ; minor-bind-keys (keys-assoc) -(defun minor-bind-keys (keys-assoc) - " Establish BINDINGS assoc list in current buffer, returning a list - for subsequent use by minor-unbind-keys to resume overloaded local - bindings." - (interactive) - ;; Cycle thru key list, registering prevailing local binding for key, if - ;; any (for prospective resumption by outline-minor-unbind-keys), then - ;; overloading it with outline-mode one. - (let ((local-map (or (current-local-map) - (make-sparse-keymap))) - key new-func unbinding-registry prevailing-func) - (while keys-assoc - (setq curr-key (car (car keys-assoc))) - (setq new-func (car (cdr (car keys-assoc)))) - (setq prevailing-func (local-key-binding curr-key)) - (if (not (symbolp prevailing-func)) - (setq prevailing-func nil)) - ;; Register key being changed, prevailing local binding, & new binding: - (setq unbinding-registry - (cons (list curr-key (local-key-binding curr-key) new-func) - unbinding-registry)) - ; Make the binding: - - (define-key local-map curr-key new-func) - ; Increment for next iteration: - (setq keys-assoc (cdr keys-assoc))) - ; Establish modified map: - (use-local-map local-map) - ; Return the registry: - unbinding-registry) - ) - -;;;_ ; minor-relinquish-keys (unbinding-registry) -(defun minor-relinquish-keys (unbinding-registry) - " Given registry of MODAL-BINDINGS, as produced by minor-bind-keys, - resume the former local keybindings of those keys that retain the - local bindings set by minor-bind-keys. Changed local bindings are - left alone, so other minor (user or modal) bindings are not disrupted. - - Returns a list of those registrations which were not, because of - tampering subsequent to the registration by minor-bind-keys, resumed." - (interactive) - (let (residue curr-item curr-key curr-resume curr-relinquish) - (while unbinding-registry - (setq curr-item (car unbinding-registry)) - (setq curr-key (car curr-item)) - (setq curr-resume (car (cdr curr-item))) - (setq curr-relinquish (car (cdr (cdr curr-item)))) - (if (equal (local-key-binding curr-key) curr-relinquish) - (if curr-resume - ;; Was a local binding to be resumed - do so: - (local-set-key curr-key curr-resume) - (local-unset-key curr-key)) - ;; Bindings been tampered with since registration - leave it be, and - ;; register so on residue list: - (setq residue (cons residue curr-item))) - (setq unbinding-registry (cdr unbinding-registry))) - residue) - ) -;;;_ = outline-minor-prior-keys -(defvar outline-minor-prior-keys () - "Former key bindings assoc-list, for resumption from outline minor-mode.") -(make-variable-buffer-local 'outline-minor-prior-keys) - - ; Both major and minor mode - ; bindings are dictated by - ; this list - put your - ; settings here. -;;;_ > outline-minor-bind-keys () -(defun outline-minor-bind-keys () - " Establish outline-mode keybindings as MINOR modality of current buffer." - (setq outline-minor-prior-keys - (minor-bind-keys outline-mode-keys))) -;;;_ > outline-minor-relinquish-keys () -(defun outline-minor-relinquish-keys () - " Resurrect local keybindings as they were before outline-minor-bind-keys." - (minor-relinquish-keys outline-minor-prior-keys) -) - -;;;_ : Mode-Specific Variables Maintenance -;;;_ = outline-mode-prior-settings +;;;_ - Key bindings +;;;_ = outline-mode-map +(defvar outline-mode-map nil "Keybindings for (allout) outline minor mode.") +;;;_ > produce-outline-mode-map (keymap-alist &optional base-map) +(defun produce-outline-mode-map (keymap-list &optional base-map) + "Produce keymap for use as outline-mode-map, from keymap-list. + +Built on top of optional BASE-MAP, or empty sparse map if none specified. +See doc string for outline-keybindings-list for format of binding list." + (let ((map (or base-map (make-sparse-keymap)))) + (mapcar (lambda (cell) + (apply 'define-key map (if (null (cdr (cdr cell))) + (cons (concat outline-command-prefix + (car cell)) + (cdr cell)) + (list (car cell) (car (cdr cell)))))) + keymap-list) + map)) +;;;_ = outline-prior-bindings - being deprecated. +(defvar outline-prior-bindings nil + "Variable for use in V18, with outline-added-bindings, for +resurrecting, on mode deactivation, bindings that existed before +activation. Being deprecated.") +;;;_ = outline-added-bindings - being deprecated +(defvar outline-added-bindings nil + "Variable for use in V18, with outline-prior-bindings, for +resurrecting, on mode deactivation, bindings that existed before +activation. Being deprecated.") +;;;_ - Mode-Specific Variable Maintenance Utilities +;;;_ = outline-mode-prior-settings (defvar outline-mode-prior-settings nil - "For internal use by outline mode, registers settings to be resumed -on mode deactivation.") + "Internal outline mode use; settings to be resumed on mode deactivation.") (make-variable-buffer-local 'outline-mode-prior-settings) -;;;_ > outline-resumptions (name &optional value) +;;;_ > outline-resumptions (name &optional value) (defun outline-resumptions (name &optional value) - " Registers information for later reference, or performs resumption of - outline-mode specific values. First arg is NAME of variable affected. - optional second arg is list containing outline-mode-specific VALUE to - be impose on named variable, and to be registered. (It's a list so you - can specify registrations of null values.) If no value is specified, - the registered value is returned (encapsulated in the list, so the - caller can distinguish nil vs no value), and the registration is popped - from the list." + "Registers or resumes settings over outline-mode activation/deactivation. + +First arg is NAME of variable affected. Optional second arg is list +containing outline-mode-specific VALUE to be imposed on named +variable, and to be registered. (It's a list so you can specify +registrations of null values.) If no value is specified, the +registered value is returned (encapsulated in the list, so the caller +can distinguish nil vs no value), and the registration is popped +from the list." (let ((on-list (assq name outline-mode-prior-settings)) prior-capsule ; By 'capsule' i mean a list @@ -495,8 +673,9 @@ on mode deactivation.") (cons (list name (if (boundp name) (list (symbol-value name)))) outline-mode-prior-settings))) - ; And impose the new value: - (set name (car value))) + ; And impose the new value, locally: + (progn (make-local-variable name) + (set name (car value)))) ;; Relinquishing: (if (not on-list) @@ -522,644 +701,974 @@ on mode deactivation.") (cdr outline-mode-prior-settings))) (setq outline-mode-prior-settings rebuild))))) ) - -;;;_ : Overall -;;;_ = outline-mode +;;;_ - Mode-specific incidentals +;;;_ = outline-during-write-cue nil +(defvar outline-during-write-cue nil + "Used to inhibit outline change-protection during file write. + +See also `outline-post-command-business', `outline-write-file-hook', +`outline-before-change-protect', and `outline-post-command-business' +functions.") +;;;_ = outline-override-protect nil +(defvar outline-override-protect nil + "Used in outline-mode for regulate of concealed-text protection mechanism. + +Allout outline mode regulates alteration of concealed text to protect +against inadvertant, unnoticed changes. This is for use by specific, +native outline functions to temporarily override that protection. +It's automatically reset to nil after every buffer modification.") +(make-variable-buffer-local 'outline-override-protect) +;;;_ > outline-unprotected (expr) +(defmacro outline-unprotected (expr) + "Evaluate EXPRESSION with `outline-override-protect' let-bound 't'." + (` (let ((outline-override-protect t)) + (, expr)))) +;;;_ = outline-undo-aggregation +(defvar outline-undo-aggregation 30 + "Amount of successive self-insert actions to bunch together per undo. + +This is purely a kludge variable, regulating the compensation for a bug in +the way that before-change-function and undo interact.") +(make-variable-buffer-local 'outline-undo-aggregation) +;;;_ = file-var-bug hack +(defvar outline-v18/9-file-var-hack nil + "Horrible hack used to prevent invalid multiple triggering of outline +mode from prop-line file-var activation. Used by outline-mode function +to track repeats.") +;;;_ > outline-write-file-hook () +(defun outline-write-file-hook () + "In outline mode, run as a local-write-file-hooks activity. + +Currently just sets 'outline-during-write-cue', so outline-change- +protection knows to keep inactive during file write." + (setq outline-during-write-cue t) + nil) + +;;;_ #2 Mode activation +;;;_ = outline-mode (defvar outline-mode () "Allout outline mode minor-mode flag.") (make-variable-buffer-local 'outline-mode) -;;;_ > outline-mode (&optional toggle) +;;;_ > outline-mode-p () +(defmacro outline-mode-p () + "Return t if outline-mode is active in current buffer." + 'outline-mode) +;;;_ = outline-explicitly-deactivated +(defvar outline-explicitly-deactivated nil + "Outline-mode was last deliberately deactived. +So outline-post-command-business should not reactivate it...") +(make-variable-buffer-local 'outline-explicitly-deactivated) +;;;_ > outline-init (&optional mode) +(defun outline-init (&optional mode) + "Prime outline-mode to enable/disable auto-activation, wrt `outline-layout'. + +MODE is one of the following symbols: + + - nil \(or no argument) deactivate auto-activation/layou; + - 'activate', enable auto-activation only; + - 'ask', enable auto-activation, and enable auto-layout but with + confirmation for layout operation solicitated from user each time; + - 'report', just report and return the current auto-activation state; + - anything else \(eg, t) for auto-activation and auto-layout, without + any confirmation check. + +Use this function to setup your emacs session for automatic activation +of allout outline mode, contingent to the buffer-specific setting of +the `outline-layout' variable. (See `outline-layout' and +`outline-expose-topic' docstrings for more details on auto layout). + +`outline-init' works by setting up (or removing) the outline-mode +find-file-hook, and giving `outline-auto-activation' a suitable +setting. + +To prime your emacs session for full auto-outline operation, include +the following two lines in your emacs init file: + +\(require 'allout) +\(outline-init t)" + + (interactive) + (if (interactive-p) + (progn + (setq mode + (completing-read + (concat "Select outline auto setup mode " + "(empty for report, ? for options) ") + '(("nil")("full")("activate")("deactivate") + ("ask") ("report") ("")) + nil + t)) + (if (string= mode "") + (setq mode 'report) + (setq mode (intern-soft mode))))) + (let + ;; convenience aliases, for consistent ref to respective vars: + ((hook 'outline-find-file-hook) + (curr-mode 'outline-auto-activation)) + + (cond ((not mode) + (setq find-file-hooks (delq hook find-file-hooks)) + (if (interactive-p) + (message "Allout outline mode auto-activation inhibited."))) + ((eq mode 'report) + (if (not (memq hook find-file-hooks)) + (outline-init nil) + ;; Just punt and use the reports from each of the modes: + (outline-init (symbol-value curr-mode)))) + (t (add-hook 'find-file-hooks hook) + (set curr-mode ; 'set', not 'setq'! + (cond ((eq mode 'activate) + (message + "Outline mode auto-activation enabled.") + 'activate) + ((eq mode 'report) + ;; Return the current mode setting: + (outline-init mode)) + ((eq mode 'ask) + (message + (concat "Outline mode auto-activation and " + "-layout \(upon confirmation) enabled.")) + 'ask) + ((message + "Outline mode auto-activation and -layout enabled.") + 'full))))))) + +;;;_ > outline-mode (&optional toggle) +;;;_ : Defun: (defun outline-mode (&optional toggle) - " Set minor mode for editing outlines with selective display. - - Look below the description of the bindings for explanation of the - terminology use in outline-mode commands. - - (Note - this is not a proper minor mode, because it does affect key - bindings. It's not too improper, however, because it does resurrect - any bindings which have not been tampered with since it changed them.) - -Exposure Commands Movement Commands -C-c C-h outline-hide-current-subtree C-c C-n outline-next-visible-heading -C-c C-i outline-show-current-children C-c C-p outline-previous-visible-heading -C-c C-s outline-show-current-subtree C-c C-u outline-up-current-level -C-c C-o outline-show-current-entry C-c C-f outline-forward-current-level -C-c ! outline-show-all C-c C-b outline-backward-current-level - outline-hide-current-leaves C-c C-e outline-end-of-current-entry - C-c C-a outline-beginning-of-current-entry - - -Topic Header Generation Commands -C-c open-sibtopic Create a new sibling after current topic -C-c . open-subtopic ... an offspring of current topic -C-c , open-supertopic ... a sibling of the current topic's parent - -Level and Prefix Adjustment Commands -C-c > outline-shift-in Shift current topic and all offspring deeper -C-c < outline-shift-out ... less deep -C-c outline-rebullet-topic Reconcile bullets of topic and its offspring - - distinctive bullets are not changed, all - others set suitable according to depth +;;;_ . Doc string: + "Toggle minor mode for controlling exposure and editing of text outlines. + +Optional arg forces mode reactivation iff arg is positive num or symbol. + +Allout outline mode provides extensive outline formatting and +manipulation capabilities. It is specifically aimed at supporting +outline structuring and manipulation of syntax-sensitive text, eg +programming languages. \(For an example, see the allout code itself, +which is organized in outline structure.\) + +It also includes such things as topic-oriented repositioning, cut, and +paste; integral outline exposure-layout; incremental search with +dynamic exposure/conceament of concealed text; automatic topic-number +maintenance; and many other features. + +See the docstring of the variable `outline-init' for instructions on +priming your emacs session for automatic activation of outline-mode, +according to file-var settings of the `outline-layout' variable. + +Below is a description of the bindings, and then explanation of +special outline-mode features and terminology. + +The bindings themselves are established according to the values of +variables `outline-keybindings-list' and `outline-command-prefix', +each time the mode is invoked. Prior bindings are resurrected when +the mode is revoked. + + Navigation: Exposure Control: + ---------- ---------------- +C-c C-n outline-next-visible-heading | C-c C-h outline-hide-current-subtree +C-c C-p outline-previous-visible-heading | C-c C-i outline-show-children +C-c C-u outline-up-current-level | C-c C-s outline-show-current-subtree +C-c C-f outline-forward-current-level | C-c C-o outline-show-current-entry +C-c C-b outline-backward-current-level | ^U C-c C-s outline-show-all +C-c C-e outline-end-of-current-entry | outline-hide-current-leaves +C-c C-a outline-beginning-of-current-entry, alternately, goes to hot-spot + + Topic Header Production: + ----------------------- +C-c outline-open-sibtopic Create a new sibling after current topic. +C-c . outline-open-subtopic ... an offspring of current topic. +C-c , outline-open-supertopic ... a sibling of the current topic's parent. + + Topic Level and Prefix Adjustment: + --------------------------------- +C-c > outline-shift-in Shift current topic and all offspring deeper. +C-c < outline-shift-out ... less deep. +C-c outline-rebullet-topic Reconcile bullets of topic and its' offspring + - distinctive bullets are not changed, others + alternated according to nesting depth. C-c b outline-rebullet-current-heading Prompt for alternate bullet for - current topic + current topic. C-c # outline-number-siblings Number bullets of topic and siblings - the offspring are not affected. With repeat count, revoke numbering. -Killing and Yanking - all keep siblings numbering reconciled as appropriate -C-k outline-kill-line Regular kill line, but respects numbering ,etc -C-c C-k outline-kill-topic Kill current topic, including offspring + Topic-oriented Killing and Yanking: + ---------------------------------- +C-c C-k outline-kill-topic Kill current topic, including offspring. +C-k outline-kill-line Like kill-line, but reconciles numbering, etc. C-y outline-yank Yank, adjusting depth of yanked topic to depth of heading if yanking into bare topic - heading (ie, prefix sans text) + heading (ie, prefix sans text). M-y outline-yank-pop Is to outline-yank as yank-pop is to yank -Misc commands + Misc commands: + ------------- C-c @ outline-resolve-xref pop-to-buffer named by xref (cf - outline-file-xref-bullet) -C-c c outline-copy-exposed Copy outline sans all hidden stuff to - another buffer whose name is derived - from the current one - \"XXX exposed\" -M-x outlinify-sticky Activate outline mode for current buffer - and establish -*- outline -*- mode specifier - as well as file local vars to automatically - set exposure. Try it. - - Terminology - -Topic: A basic cohesive component of an emacs outline, which can - be closed (made hidden), opened (revealed), generated, - traversed, and shifted as units, using outline-mode functions. - A topic is composed of a HEADER, a BODY, and SUBTOPICs (see below). - -Exposure: Hidden (~closed~) topics are represented by ellipses ('...') - at the end of the visible SUPERTOPIC which contains them, - rather than by their actual text. Hidden topics are still - susceptible to editing and regular movement functions, they - just are not displayed normally, effectively collapsed into - the ellipses which represent them. Outline mode provides - the means to selectively expose topics based on their - NESTING. - - SUBTOPICS of a topic can be hidden and subsequently revealed - based on their DEPTH relative to the supertopic from which - the exposure is being done. - - The BODIES of a topic do not generally become visible except - during exposure of entire subtrees (see documentation for - '-current-subtree'), or when the entry is explicitly exposed - with the 'outline-show-entry' function, or (if you have a - special version of isearch installed) when encountered by - incremental searches. - - The CURRENT topic is the more recent visible one before or - including the text cursor. - -Header: The initial portion of an outline topic. It is composed of a - topic header PREFIX at the beginning of the line, followed by - text to the end of the EFFECTIVE LINE. - -Body: Any subsequent lines of text following a topic header and preceding - the next one. This is also referred to as the entry for a topic. - -Prefix: The text which distinguishes topic headers from normal text - lines. There are two forms, both of which start at the beginning - of the topic header (EFFECTIVE) line. The length of the prefix - represents the DEPTH of the topic. The fundamental sort begins - either with solely an asterisk ('*') or else dot ('.') followed - by zero or more spaces and then an outline BULLET. [Note - you - can now designate your own, arbitrary HEADER-LEAD string, by - setting the variable 'outline-header-prefix'.] The second form - is for backwards compatibility with the original emacs outline - mode, and consists solely of asterisks. Both sorts are - recognized by all outline commands. The first sort is generated - by outline topic production commands if the emacs variable - outline-old-style-prefixes is nil, otherwise the second style is - used. - -Bullet: An outline prefix bullet is one of the characters on either - of the outline bullet string vars, 'outline-plain-bullets-string' - and 'outline-distinctive-bullets-string'. (See their - documentation for more details.) The default choice of bullet - for any prefix depends on the DEPTH of the topic. - -Depth and Nesting: - The length of a topic header prefix, from the initial - character to the bullet (inclusive), represents the depth of - the topic. A topic is considered to contain the subsequent - topics of greater depth up to the next topic of the same - depth, and the contained topics are recursively considered to - be nested within all containing topics. Contained topics are - called subtopics. Immediate subtopics are called 'children'. - Containing topics are supertopicsimmediate supertopics are - 'parents'. Contained topics of the same depth are called - siblings. - -Effective line: The regular ascii text in which form outlines are - saved are manipulated in outline-mode to engage emacs' - selective-display faculty. The upshot is that the - effective end of an outline line can be terminated by - either a normal Unix newline char, \n, or the special - outline-mode eol, ^M. This only matters at the user - level when you're doing searches which key on the end of - line character." - + outline-file-xref-bullet) +C-c c outline-copy-exposed Copy current topic outline sans concealed + text, to buffer with name derived from + current buffer - \"XXX exposed\" +M-x outlineify-sticky Activate outline mode for current buffer, + and establish a default file-var setting + for `outline-layout'. +ESC ESC (outline-init t) Setup emacs session for outline mode + auto-activation. + + HOT-SPOT Operation + +Hot-spot operation provides a means for easy, single-keystroke outline +navigation and exposure control. + +\\ +When the text cursor is positioned directly on the bullet character of +a topic, regular characters (a to z) invoke the commands of the +corresponding outline-mode keymap control chars. For example, \"f\" +would invoke the command typically bound to \"C-c C-f\" +\(\\[outline-forward-current-level] `outline-forward-current-level'). + +Thus, by positioning the cursor on a topic bullet, you can execute +the outline navigation and manipulation commands with a single +keystroke. Non-literal chars never get this special translation, so +you can use them to get away from the hot-spot, and back to normal +operation. + +Note that the command `outline-beginning-of-current-entry' \(\\[outline-beginning-of-current-entry]\) +will move to the hot-spot when the cursor is already located at the +beginning of the current entry, so you can simply hit \\[outline-beginning-of-current-entry] +twice in a row to get to the hot-spot. + + Terminology + +Topic hierarchy constituents - TOPICS and SUBTOPICS: + +TOPIC: A basic, coherent component of an emacs outline. It can + contain other topics, and it can be subsumed by other topics, +CURRENT topic: + The visible topic most immediately containing the cursor. +DEPTH: The degree of nesting of a topic; it increases with + containment. Also called the: +LEVEL: The same as DEPTH. + +ANCESTORS: + The topics that contain a topic. +PARENT: A topic's immediate ancestor. It has a depth one less than + the topic. +OFFSPRING: + The topics contained by a topic; +SUBTOPIC: + An immediate offspring of a topic; +CHILDREN: + The immediate offspring of a topic. +SIBLINGS: + Topics having the same parent and depth. + +Topic text constituents: + +HEADER: The first line of a topic, include the topic PREFIX and header + text. +PREFIX: The leading text of a topic which which distinguishes it from + normal text. It has a strict form, which consists of a + prefix-lead string, padding, and a bullet. The bullet may be + followed by a number, indicating the ordinal number of the + topic among its siblings, a space, and then the header text. + + The relative length of the PREFIX determines the nesting depth + of the topic. +PREFIX-LEAD: + The string at the beginning of a topic prefix, normally a '.'. + It can be customized by changing the setting of + `outline-header-prefix' and then reinitializing outline-mode. + + By setting the prefix-lead to the comment-string of a + programming language, you can embed outline-structuring in + program code without interfering with the language processing + of that code. See `outline-use-mode-specific-leader' + docstring for more detail. +PREFIX-PADDING: + Spaces or asterisks which separate the prefix-lead and the + bullet, according to the depth of the topic. +BULLET: A character at the end of the topic prefix, it must be one of + the characters listed on 'outline-plain-bullets-string' or + 'outline-distinctive-bullets-string'. (See the documentation + for these variables for more details.) The default choice of + bullet when generating varies in a cycle with the depth of the + topic. +ENTRY: The text contained in a topic before any offspring. +BODY: Same as ENTRY. + + +EXPOSURE: + The state of a topic which determines the on-screen visibility + of its' offspring and contained text. +CONCEALED: + Topics and entry text whose display is inhibited. Contiguous + units of concealed text is represented by '...' ellipses. + (Ref the 'selective-display' var.) + + Concealed topics are effectively collapsed within an ancestor. +CLOSED: A topic whose immediate offspring and body-text is concealed. +OPEN: A topic that is not closed, though its' offspring or body may be." +;;;_ . Code (interactive "P") - (let* ((active (and (boundp 'outline-mode) outline-mode)) - (toggle (and toggle - (or (and (listp toggle)(car toggle)) - toggle))) - (explicit-activation (and toggle - (or (symbolp toggle) - (and (natnump toggle) - (not (zerop toggle))))))) - + (let* ((active (and (not (equal major-mode 'outline)) + (outline-mode-p))) + ; Massage universal-arg 'toggle' val: + (toggle (and toggle + (or (and (listp toggle)(car toggle)) + toggle))) + ; Activation specficially demanded? + (explicit-activation (or + ;; + (and toggle + (or (symbolp toggle) + (and (natnump toggle) + (not (zerop toggle))))))) + ;; outline-mode already called once during this complex command? + (same-complex-command (eq outline-v18/9-file-var-hack + (car command-history))) + do-layout + ) + + ; See comments below re v19.18,.19 bug. + (setq outline-v18/9-file-var-hack (car command-history)) + (cond - ((and (not explicit-activation) (or active toggle)) - ;; Activation not explicitly requested, and either in active - ;; state or deactivation specifically requested: - (outline-minor-relinquish-keys) + ;; Provision for v19.18, 19.19 bug - + ;; Emacs v 19.18, 19.19 file-var code invokes prop-line-designated + ;; modes twice when file is visited. We have to avoid toggling mode + ;; off on second invocation, so we detect it as best we can, and + ;; skip everything. + ((and same-complex-command ; Still in same complex command + ; as last time outline-mode invoked. + active ; Already activated. + (not explicit-activation) ; Prop-line file-vars don't have args. + (string-match "^19.1[89]" ; Bug only known to be in v19.18 and + emacs-version)); 19.19. + t) + + ;; Deactivation: + ((and (not explicit-activation) + (or active toggle)) + ; Activation not explicitly + ; requested, and either in + ; active state or *de*activation + ; specifically requested: + (setq outline-explicitly-deactivated t) + (if (string-match "^18\." emacs-version) + ; Revoke those keys that remain + ; as we set them: + (let ((curr-loc (current-local-map))) + (mapcar '(lambda (cell) + (if (eq (lookup-key curr-loc (car cell)) + (car (cdr cell))) + (define-key curr-loc (car cell) + (assq (car cell) outline-prior-bindings)))) + outline-added-bindings) + (outline-resumptions 'outline-added-bindings) + (outline-resumptions 'outline-prior-bindings))) + + (if outline-old-style-prefixes + (progn + (outline-resumptions 'outline-primary-bullet) + (outline-resumptions 'outline-old-style-prefixes))) (outline-resumptions 'selective-display) - (outline-resumptions 'indent-tabs-mode) + (if (and (boundp 'before-change-function) before-change-function) + (outline-resumptions 'before-change-function)) + (setq pre-command-hook (delq 'outline-pre-command-business + pre-command-hook)) + (setq local-write-file-hooks + (delq 'outline-write-file-hook + local-write-file-hooks)) (outline-resumptions 'paragraph-start) (outline-resumptions 'paragraph-separate) + (outline-resumptions (if (string-match "^18" emacs-version) + 'auto-fill-hook + 'auto-fill-function)) + (outline-resumptions 'outline-former-auto-filler) (setq outline-mode nil)) - ;; Deactivation *not* indicated. + ;; Activation: ((not active) - ;; Not already active - activate: - (outline-minor-bind-keys) - (outline-resumptions 'selective-display '(t)) - (outline-resumptions 'indent-tabs-mode '(nil)) - (or (assq 'outline-mode minor-mode-alist) - (setq minor-mode-alist - (cons '(outline-mode " Outline") minor-mode-alist))) + (setq outline-explicitly-deactivated nil) + (if outline-old-style-prefixes + (progn ; Inhibit all the fancy formatting: + (outline-resumptions 'outline-primary-bullet '("*")) + (outline-resumptions 'outline-old-style-prefixes '(())))) + + (outline-infer-header-lead) + (outline-infer-body-reindent) + (set-outline-regexp) + ; Produce map from current version + ; of outline-keybindings-list: + (if (boundp 'minor-mode-map-alist) + + (progn ; V19, and maybe lucid and + ; epoch, minor-mode key bindings: + (setq outline-mode-map + (produce-outline-mode-map outline-keybindings-list)) + (fset 'outline-mode-map outline-mode-map) + ; Include on minor-mode-map-alist, + ; if not already there: + (if (not (member '(outline-mode . outline-mode-map) + minor-mode-map-alist)) + (setq minor-mode-map-alist + (cons '(outline-mode . outline-mode-map) + minor-mode-map-alist)))) + + ; V18 minor-mode key bindings: + ; Stash record of added bindings + ; for later revocation: + (outline-resumptions 'outline-added-bindings + (list outline-keybindings-list)) + (outline-resumptions 'outline-prior-bindings + (list (current-local-map))) + ; and add them: + (use-local-map (produce-outline-mode-map outline-keybindings-list + (current-local-map))) + ) + + ; selective-display is the + ; emacs conditional exposure + ; mechanism: + (outline-resumptions 'selective-display '(t)) + (if outline-inhibit-protection + t + (outline-resumptions 'before-change-function + '(outline-before-change-protect))) + ; Temporarily set by any outline + ; functions that can be trusted to + ; deal properly with concealed text. + (add-hook 'local-write-file-hooks 'outline-write-file-hook) + ; Custom auto-fill func, to support + ; respect for topic headline, + ; hanging-indents, etc: + (let* ((fill-func-var (if (string-match "^18" emacs-version) + 'auto-fill-hook + 'auto-fill-function)) + (fill-func (symbol-value fill-func-var))) + ;; Register prevailing fill func for use by outline-auto-fill: + (outline-resumptions 'outline-former-auto-filler (list fill-func)) + ;; Register outline-auto-fill to be used if filling is active: + (outline-resumptions fill-func-var '(outline-auto-fill))) + ;; Paragraphs are broken by topic headlines. (make-local-variable 'paragraph-start) (outline-resumptions 'paragraph-start - (list (concat paragraph-start "\\|^\\(" - outline-regexp "\\)"))) + (list (concat paragraph-start "\\|^\\(" + outline-regexp "\\)"))) (make-local-variable 'paragraph-separate) (outline-resumptions 'paragraph-separate - (list (concat paragraph-separate "\\|^\\(" - outline-regexp "\\)"))) + (list (concat paragraph-separate "\\|^\\(" + outline-regexp "\\)"))) + + (or (assq 'outline-mode minor-mode-alist) + (setq minor-mode-alist + (cons '(outline-mode " Outl") minor-mode-alist))) + + (if outline-layout + (setq do-layout t)) (if outline-enwrap-isearch-mode - (outline-enwrap-isearch)) - (if (and outline-use-hanging-indents - (boundp 'filladapt-prefix-table)) - ;; Add outline-prefix recognition to filladapt - not standard: - (progn (setq filladapt-prefix-table - (cons (cons (concat "\\(" outline-regexp "\\) ") - 'filladapt-hanging-list) - filladapt-prefix-table)) - (setq filladapt-hanging-list-prefixes - (cons outline-regexp - filladapt-hanging-list-prefixes)))) + (outline-enwrap-isearch)) + (run-hooks 'outline-mode-hook) (setq outline-mode t)) - ) ; cond - ) ; let* - ) ; defun - -;;;_ #2 Internal Position State-Tracking Variables -;;; All basic outline functions which directly do string matches to + ;; Reactivation: + ((setq do-layout t) + (outline-infer-body-reindent)) + ) ; cond + + (if (and do-layout + outline-auto-activation + (listp outline-layout) + (and (not (eq outline-auto-activation 'activate)) + (if (eq outline-auto-activation 'ask) + (if (y-or-n-p (format "Expose %s with layout '%s'? " + (buffer-name) + outline-layout)) + t + (message "Skipped %s layout." (buffer-name)) + nil) + t))) + (save-excursion + (message "Adjusting '%s' exposure..." (buffer-name)) + (goto-char 0) + (outline-this-or-next-heading) + (condition-case err + (progn + (apply 'outline-expose-topic (list outline-layout)) + (message "Adjusting '%s' exposure... done." (buffer-name))) + ;; Problem applying exposure - notify user, but don't + ;; interrupt, eg, file visit: + (error (message "%s" (car (cdr err))) + (sit-for 1))))) + outline-mode + ) ; let* + ) ; defun + +;;;_ #3 Internal Position State-Tracking - "outline-recent-*" funcs +;;; All the basic outline functions that directly do string matches to ;;; evaluate heading prefix location set the variables -;;; outline-recent-prefix-beginning and outline-recent-prefix-end when -;;; successful. Functions starting with 'outline-recent-' all use -;;; this state, providing the means to avoid redundant searches for -;;; just established data. This optimization can provide significant -;;; speed improvement, but it must be employed carefully. -;;;_ = outline-recent-prefix-beginning +;;; `outline-recent-prefix-beginning' and `outline-recent-prefix-end' +;;; when successful. Functions starting with `outline-recent-' all +;;; use this state, providing the means to avoid redundant searches +;;; for just-established data. This optimization can provide +;;; significant speed improvement, but it must be employed carefully. +;;;_ = outline-recent-prefix-beginning (defvar outline-recent-prefix-beginning 0 - " Buffer point of the start of the last topic prefix encountered.") + "Buffer point of the start of the last topic prefix encountered.") (make-variable-buffer-local 'outline-recent-prefix-beginning) -;;;_ = outline-recent-prefix-end +;;;_ = outline-recent-prefix-end (defvar outline-recent-prefix-end 0 - " Buffer point of the end of the last topic prefix encountered.") + "Buffer point of the end of the last topic prefix encountered.") (make-variable-buffer-local 'outline-recent-prefix-end) - -;;;_ #3 Exposure Control - -;;;_ : Fundamental -;;;_ > outline-flag-region (from to flag) -(defun outline-flag-region (from to flag) - " Hides or shows lines from FROM to TO, according to FLAG. - Uses emacs selective-display, where text is show if FLAG put at - beginning of line is `\\n' (newline character), while text is - hidden if FLAG is `\\^M' (control-M). - - returns nil iff no changes were effected." - (let ((buffer-read-only nil)) - (subst-char-in-region from to - (if (= flag ?\n) ?\^M ?\n) - flag t))) -;;;_ > outline-flag-current-subtree (flag) -(defun outline-flag-current-subtree (flag) - (save-excursion - (outline-back-to-current-heading) - (outline-flag-region (point) - (progn (outline-end-of-current-subtree) (point)) - flag))) - -;;;_ : Topic-specific -;;;_ > outline-hide-current-entry () -(defun outline-hide-current-entry () - "Hide the body directly following this heading." - (interactive) - (outline-back-to-current-heading) - (save-excursion - (outline-flag-region (point) - (progn (outline-end-of-current-entry) (point)) - ?\^M))) -;;;_ > outline-show-current-entry (&optional arg) -(defun outline-show-current-entry (&optional arg) - "Show body directly following this heading, or hide it if repeat count." - (interactive "P") - (if arg - (outline-hide-current-entry) - (save-excursion - (outline-flag-region (point) - (progn (outline-end-of-current-entry) (point)) - ?\n)))) -;;;_ > outline-show-entry () -; outline-show-entry basically for isearch dynamic exposure, as is... -(defun outline-show-entry () - " Like outline-show-current-entry, but reveals an entry that is nested - within hidden topics." - (interactive) - (save-excursion - (outline-goto-prefix) - (outline-flag-region (if (not (bobp)) (1- (point)) (point)) - (progn (outline-pre-next-preface) (point)) ?\n))) -;;;_ > outline-hide-current-entry-completely () -; ... outline-hide-current-entry-completely also for isearch dynamic exposure: -(defun outline-hide-current-entry-completely () - "Like outline-hide-current-entry, but conceal topic completely." - (interactive) - (save-excursion - (outline-goto-prefix) - (outline-flag-region (if (not (bobp)) (1- (point)) (point)) - (progn (outline-pre-next-preface) - (if (looking-at "\C-m") - (point) - (1- (point)))) - ?\C-m))) -;;;_ > outline-show-current-subtree () -(defun outline-show-current-subtree () - "Show everything after this heading at deeper levels." - (interactive) - (outline-flag-current-subtree ?\n)) -;;;_ > outline-hide-current-subtree (&optional just-close) -(defun outline-hide-current-subtree (&optional just-close) - - " Hide everything after this heading at deeper levels, or if it's - already closed, and optional arg JUST-CLOSE is nil, hide the current - level." - - (interactive) - (let ((orig-eol (save-excursion - (end-of-line)(outline-goto-prefix)(end-of-line)(point)))) - (outline-flag-current-subtree ?\^M) - (if (and (= orig-eol (save-excursion (goto-char orig-eol) - (end-of-line) - (point))) - ;; Structure didn't change - try hiding current level: - (if (not just-close) - (outline-up-current-level 1 t))) - (outline-hide-current-subtree)))) -;;;_ > outline-show-current-branches () -(defun outline-show-current-branches () - "Show all subheadings of this heading, but not their bodies." - (interactive) - (outline-show-current-children 1000)) -;;;_ > outline-hide-current-leaves () -(defun outline-hide-current-leaves () - "Hide all body after this heading at deeper levels." - (interactive) - (outline-back-to-current-heading) - (outline-hide-region-body (point) (progn (outline-end-of-current-subtree) - (point)))) -;;;_ > outline-show-current-children (&optional level) -(defun outline-show-current-children (&optional level) - " Show all direct subheadings of this heading. Optional LEVEL specifies - how many levels below the current level should be shown." - (interactive "p") - (or level (setq level 1)) - (save-excursion - (save-restriction - (beginning-of-line) - (setq level (+ level (progn (outline-back-to-current-heading) - (outline-recent-depth)))) - (narrow-to-region (point) - (progn (outline-end-of-current-subtree) (1+ (point)))) - (goto-char (point-min)) - (while (and (not (eobp)) - (outline-next-heading)) - (if (<= (outline-recent-depth) level) - (save-excursion - (let ((end (1+ (point)))) - (forward-char -1) - (if (memq (preceding-char) '(?\n ?\^M)) - (forward-char -1)) - (outline-flag-region (point) end ?\n)))))))) - -;;;_ : Region and beyond -;;;_ > outline-show-all () -(defun outline-show-all () - "Show all of the text in the buffer." - (interactive) - (outline-flag-region (point-min) (point-max) ?\n)) -;;;_ > outline-hide-bodies () -(defun outline-hide-bodies () - "Hide all of buffer except headings." - (interactive) - (outline-hide-region-body (point-min) (point-max))) -;;;_ > outline-hide-region-body (start end) -(defun outline-hide-region-body (start end) - "Hide all body lines in the region, but not headings." - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char (point-min)) - (while (not (eobp)) - (outline-flag-region (point) - (progn (outline-pre-next-preface) (point)) ?\^M) - (if (not (eobp)) - (forward-char - (if (looking-at "[\n\^M][\n\^M]") - 2 1))))))) -;;;_ > outline-expose () -(defun outline-expose (spec &rest followers) - - "Dictate wholesale exposure scheme for current topic, according to SPEC. - -SPEC is either a number or a list of specs. Optional successive args -dictate exposure for subsequent siblings of current topic. - -Numbers, the symbols '*' and '+', and the null list dictate different -exposure depths for the corresponding topic. Numbers indicate the -depth to open, with negative numbers first forcing a close, and then -opening to their absolute value. Positive numbers jsut reopen, and 0 -just closes. '*' completely opens the topic, including bodies, and -'+' shows all the sub headers, but not the bodies. - -If the spec is a list, the first element must be a number which -dictates the exposure depth of the topic as a whole. Subsequent -elements of the list are nested SPECs, dictating the specific exposure -for the corresponding offspring of the topic, as the SPEC as a whole -does for the parent topic. - -Optional FOLLOWER elements dictate exposure for subsequent siblings -of the parent topic." - - (interactive "xExposure spec: ") - (save-excursion - (let ((start-point (progn (outline-goto-prefix)(point))) - done) - (cond ((null spec) nil) - ((symbolp spec) - (if (eq spec '*) (outline-show-current-subtree)) - (if (eq spec '+) (outline-show-current-branches))) - ((numberp spec) - (if (zerop spec) - ;; Just hide if zero: - (outline-hide-current-subtree t) - (if (> 0 spec) - ;; Close before opening if negative: - (progn (outline-hide-current-subtree) - (setq spec (* -1 spec)))) - (outline-show-current-children spec))) - ((listp spec) - (outline-expose (car spec)) - (if (and (outline-descend-to-depth (+ (outline-current-depth) 1)) - (not (outline-hidden-p))) - (while (and (setq spec (cdr spec)) - (not done)) - (outline-expose (car spec)) - (setq done (not (outline-next-sibling))))))))) - (while (and followers (outline-next-sibling)) - (outline-expose (car followers)) - (setq followers (cdr followers))) - ) -;;;_ > outline-exposure '() -(defmacro outline-exposure (&rest spec) - " Literal frontend for 'outline-expose', passes arguments unevaluated, - so you needn't quote them." - (cons 'outline-expose (mapcar '(lambda (x) (list 'quote x)) spec))) - -;;;_ #4 Navigation - -;;;_ : Position Assessment - -;;;_ . Residual state - from most recent outline context operation. -;;;_ > outline-recent-depth () -(defun outline-recent-depth () - " Return depth of last heading encountered by an outline maneuvering - function. - - All outline functions which directly do string matches to assess - headings set the variables outline-recent-prefix-beginning and - outline-recent-prefix-end if successful. This function uses those settings - to return the current depth." - - (max 1 - (- outline-recent-prefix-end - outline-recent-prefix-beginning - outline-header-subtraction))) -;;;_ > outline-recent-prefix () -(defun outline-recent-prefix () - " Like outline-recent-depth, but returns text of last encountered prefix. - - All outline functions which directly do string matches to assess - headings set the variables outline-recent-prefix-beginning and - outline-recent-prefix-end if successful. This function uses those settings - to return the current depth." - (buffer-substring outline-recent-prefix-beginning outline-recent-prefix-end)) -;;;_ > outline-recent-bullet () -(defun outline-recent-bullet () - " Like outline-recent-prefix, but returns bullet of last encountered - prefix. - - All outline functions which directly do string matches to assess - headings set the variables outline-recent-prefix-beginning and - outline-recent-prefix-end if successful. This function uses those settings - to return the current depth of the most recently matched topic." - (buffer-substring (1- outline-recent-prefix-end) outline-recent-prefix-end)) - -;;;_ . Active position evaluation - if you can't use the residual state. -;;;_ > outline-on-current-heading-p () +;;;_ = outline-recent-end-of-subtree +(defvar outline-recent-end-of-subtree 0 + "Buffer point last returned by outline-end-of-current-subtree.") +(make-variable-buffer-local 'outline-recent-end-of-subtree) +;;;_ > outline-prefix-data (beg end) +(defmacro outline-prefix-data (beg end) + "Register outline-prefix state data - BEGINNING and END of prefix. + +For reference by 'outline-recent' funcs. Returns BEGINNING." + (` (setq outline-recent-prefix-end (, end) + outline-recent-prefix-beginning (, beg)))) +;;;_ > outline-recent-depth () +(defmacro outline-recent-depth () + "Return depth of last heading encountered by an outline maneuvering function. + +All outline functions which directly do string matches to assess +headings set the variables outline-recent-prefix-beginning and +outline-recent-prefix-end if successful. This function uses those settings +to return the current depth." + + '(max 1 (- outline-recent-prefix-end + outline-recent-prefix-beginning + outline-header-subtraction))) +;;;_ > outline-recent-prefix () +(defmacro outline-recent-prefix () + "Like outline-recent-depth, but returns text of last encountered prefix. + +All outline functions which directly do string matches to assess +headings set the variables outline-recent-prefix-beginning and +outline-recent-prefix-end if successful. This function uses those settings +to return the current depth." + '(buffer-substring outline-recent-prefix-beginning + outline-recent-prefix-end)) +;;;_ > outline-recent-bullet () +(defmacro outline-recent-bullet () + "Like outline-recent-prefix, but returns bullet of last encountered prefix. + +All outline functions which directly do string matches to assess +headings set the variables outline-recent-prefix-beginning and +outline-recent-prefix-end if successful. This function uses those settings +to return the current depth of the most recently matched topic." + '(buffer-substring (1- outline-recent-prefix-end) + outline-recent-prefix-end)) + +;;;_ #4 Navigation + +;;;_ - Position Assessment +;;;_ : Location Predicates +;;;_ > outline-on-current-heading-p () (defun outline-on-current-heading-p () - " Return prefix beginning point if point is on same line as current - visible topic's header line." + "Return non-nil if point is on current visible topics' header line. + +Actually, returns prefix beginning point." (save-excursion (beginning-of-line) (and (looking-at outline-regexp) - (setq outline-recent-prefix-end (match-end 0) - outline-recent-prefix-beginning (match-beginning 0))))) -;;;_ > outline-hidden-p () -(defun outline-hidden-p () + (outline-prefix-data (match-beginning 0) (match-end 0))))) +;;;_ > outline-e-o-prefix-p () +(defun outline-e-o-prefix-p () + "True if point is located where current topic prefix ends, heading begins." + (and (save-excursion (beginning-of-line) + (looking-at outline-regexp)) + (= (point)(save-excursion (outline-end-of-prefix)(point))))) +;;;_ > outline-hidden-p () +(defmacro outline-hidden-p () "True if point is in hidden text." + '(save-excursion + (and (re-search-backward "[\n\r]" () t) + (= ?\r (following-char))))) +;;;_ > outline-visible-p () +(defmacro outline-visible-p () + "True if point is not in hidden text." (interactive) - (save-excursion - (and (re-search-backward "[\C-j\C-m]" (point-min) t) - (looking-at "\C-m")))) -;;;_ > outline-current-depth () -(defun outline-current-depth () - " Return the depth to which the current containing visible topic is - nested in the outline." - (save-excursion - (if (outline-back-to-current-heading) - (max 1 - (- outline-recent-prefix-end - outline-recent-prefix-beginning - outline-header-subtraction)) - 0))) -;;;_ > outline-depth () -(defun outline-depth () - " Like outline-current-depth, but respects hidden as well as visible - topics." - (save-excursion - (if (outline-goto-prefix) - (outline-recent-depth) - (progn - (setq outline-recent-prefix-end (point) - outline-recent-prefix-beginning (point)) - 0)))) -;;;_ > outline-get-current-prefix () + '(not (outline-hidden-p))) +;;;_ : Location attributes +;;;_ > outline-depth () +(defmacro outline-depth () + "Like outline-current-depth, but respects hidden as well as visible topics." + '(save-excursion + (if (outline-goto-prefix) + (outline-recent-depth) + (progn + ;; Oops, no prefix, zero prefix data: + (outline-prefix-data (point)(point)) + ;; ... and return 0: + 0)))) +;;;_ > outline-current-depth () +(defmacro outline-current-depth () + "Return nesting depth of visible topic most immediately containing point." + '(save-excursion + (if (outline-back-to-current-heading) + (max 1 + (- outline-recent-prefix-end + outline-recent-prefix-beginning + outline-header-subtraction)) + 0))) +;;;_ > outline-get-current-prefix () (defun outline-get-current-prefix () - " Topic prefix of the current topic." + "Topic prefix of the current topic." (save-excursion (if (outline-goto-prefix) - (outline-recent-prefix)))) -;;;_ > outline-get-bullet () + (outline-recent-prefix)))) +;;;_ > outline-get-bullet () (defun outline-get-bullet () - " Return bullet of containing topic (visible or not)." + "Return bullet of containing topic (visible or not)." (save-excursion (and (outline-goto-prefix) - (outline-recent-bullet)))) -;;;_ > outline-current-bullet () + (outline-recent-bullet)))) +;;;_ > outline-current-bullet () (defun outline-current-bullet () - " Return bullet of current (visible) topic heading, or none if none found." + "Return bullet of current (visible) topic heading, or none if none found." (condition-case err (save-excursion - (outline-back-to-current-heading) - (buffer-substring (- outline-recent-prefix-end 1) - outline-recent-prefix-end)) + (outline-back-to-current-heading) + (buffer-substring (- outline-recent-prefix-end 1) + outline-recent-prefix-end)) ;; Quick and dirty provision, ostensibly for missing bullet: (args-out-of-range nil)) ) -;;;_ > outline-get-prefix-bullet (prefix) +;;;_ > outline-get-prefix-bullet (prefix) (defun outline-get-prefix-bullet (prefix) - " Return the bullet of the header prefix string PREFIX." + "Return the bullet of the header prefix string PREFIX." ;; Doesn't make sense if we're old-style prefixes, but this just ;; oughtn't be called then, so forget about it... (if (string-match outline-regexp prefix) (substring prefix (1- (match-end 0)) (match-end 0)))) -;;;_ : Within Topic -;;;_ > outline-goto-prefix () +;;;_ - Navigation macros +;;;_ > outline-next-heading () +(defmacro outline-next-heading () + "Move to the heading for the topic \(possibly invisible) before this one. + +Returns the location of the heading, or nil if none found." + + '(if (and (bobp) (not (eobp))) + (forward-char 1)) + + '(if (re-search-forward outline-line-boundary-regexp nil 0) + (progn ; Got valid location state - set vars: + (outline-prefix-data + (goto-char (or (match-beginning 2) + outline-recent-prefix-beginning)) + (or (match-end 2) outline-recent-prefix-end))))) +;;;_ : outline-this-or-next-heading +(defun outline-this-or-next-heading () + "Position cursor on current or next heading." + ;; A throwaway non-macro that is defined after outline-next-heading + ;; and usable by outline-mode. + (if (not (outline-goto-prefix)) (outline-next-heading))) +;;;_ > outline-previous-heading () +(defmacro outline-previous-heading () + "Move to the prior \(possibly invisible) heading line. + +Return the location of the beginning of the heading, or nil if not found." + + '(if (bobp) + nil + (outline-goto-prefix) + (if + ;; searches are unbounded and return nil if failed: + (or (re-search-backward outline-line-boundary-regexp nil 0) + (looking-at outline-bob-regexp)) + (progn ; Got valid location state - set vars: + (outline-prefix-data + (goto-char (or (match-beginning 2) + outline-recent-prefix-beginning)) + (or (match-end 2) outline-recent-prefix-end)))))) + +;;;_ - Subtree Charting +;;;_ " These routines either produce or assess charts, which are +;;; nested lists of the locations of topics within a subtree. +;;; +;;; Use of charts enables efficient navigation of subtrees, by +;;; requiring only a single regexp-search based traversal, to scope +;;; out the subtopic locations. The chart then serves as the basis +;;; for whatever assessment or adjustment of the subtree that is +;;; required, without requiring redundant topic-traversal procedures. + +;;;_ > outline-chart-subtree (&optional levels orig-depth prev-depth) +(defun outline-chart-subtree (&optional levels orig-depth prev-depth) + "Produce a location \"chart\" of subtopics of the containing topic. + +Optional argument LEVELS specifies the depth \(releative to start +depth\) for the chart. Subsequent optional args are not for public +use. + +Charts are used to capture outline structure, so that outline-altering +routines need assess the structure only once, and then use the chart +for their elaborate manipulations. + +Topics are entered in the chart so the last one is at the car. +The entry for each topic consists of an integer indicating the point +at the beginning of the topic. Charts for offspring consists of a +list containing, recursively, the charts for the respective subtopics. +The chart for a topics' offspring precedes the entry for the topic +itself. + +The other function parameters are for internal recursion, and should +not be specified by external callers. ORIG-DEPTH is depth of topic at +starting point, and PREV-DEPTH is depth of prior topic." + + (let ((original (not orig-depth)) ; 'orig-depth' set only in recursion. + chart curr-depth) + + (if original ; Just starting? + ; Register initial settings and + ; position to first offspring: + (progn (setq orig-depth (outline-depth)) + (or prev-depth (setq prev-depth (1+ orig-depth))) + (outline-next-heading))) + + ;; Loop over the current levels' siblings. Besides being more + ;; efficient than tail-recursing over a level, it avoids exceeding + ;; the typically quite constrained emacs max-lisp-eval-depth. + ;; Probably would speed things up to implement loop-based stack + ;; operation rather than recursing for lower levels. Bah. + (while (and (not (eobp)) + ; Still within original topic? + (< orig-depth (setq curr-depth (outline-recent-depth))) + (cond ((= prev-depth curr-depth) + ;; Register this one and move on: + (setq chart (cons (point) chart)) + (if (and levels (<= levels 1)) + ;; At depth limit - skip sublevels: + (or (outline-next-sibling curr-depth) + ;; or no more siblings - proceed to + ;; next heading at lesser depth: + (while (<= curr-depth + (outline-recent-depth)) + (outline-next-heading))) + (outline-next-heading))) + + ((and (< prev-depth curr-depth) + (or (not levels) + (> levels 0))) + ;; Recurse on deeper level of curr topic: + (setq chart + (cons (outline-chart-subtree (and levels + (1- levels)) + orig-depth + curr-depth) + chart)) + ;; ... then continue with this one. + ) + + ;; ... else nil if we've ascended back to prev-depth. + + ))) + + (if original ; We're at the last sibling on + ; the original level. Position + ; to the end of it: + (progn (and (not (eobp)) (forward-char -1)) + (and (memq (preceding-char) '(?\n ?\^M)) + (memq (aref (buffer-substring (max 1 (- (point) 3)) + (point)) + 1) + '(?\n ?\^M)) + (forward-char -1)) + (setq outline-recent-end-of-subtree (point)))) + + chart ; (nreverse chart) not necessary, + ; and maybe not preferable. + )) +;;;_ > outline-chart-siblings (&optional start end) +(defun outline-chart-siblings (&optional start end) + "Produce a list of locations of this and succeeding sibling topics. +Effectively a top-level chart of siblings. See 'outline-chart-subtree' +for an explanation of charts." + (save-excursion + (if (outline-goto-prefix) + (let ((chart (list (point)))) + (while (outline-next-sibling) + (setq chart (cons (point) chart))) + (if chart (setq chart (nreverse chart))))))) +;;;_ > outline-chart-to-reveal (chart depth) +(defun outline-chart-to-reveal (chart depth) + + "Return a flat list of hidden points in subtree CHART, up to DEPTH. + +Note that point can be left at any of the points on chart, or at the +start point." + + (let (result here) + (while (and (or (eq depth t) (> depth 0)) + chart) + (setq here (car chart)) + (if (listp here) + (let ((further (outline-chart-to-reveal here (or (eq depth t) + (1- depth))))) + ;; We're on the start of a subtree - recurse with it, if there's + ;; more depth to go: + (if further (setq result (append further result))) + (setq chart (cdr chart))) + (goto-char here) + (if (= (preceding-char) ?\r) + (setq result (cons here result))) + (setq chart (cdr chart)))) + result)) +;;;_ X outline-chart-spec (chart spec &optional exposing) +(defun outline-chart-spec (chart spec &optional exposing) + "Not yet \(if ever\) implemented. + +Produce exposure directives given topic/subtree CHART and an exposure SPEC. + +Exposure spec indicates the locations to be exposed and the prescribed +exposure status. Optional arg EXPOSING is an integer, with 0 +indicating pending concealment, anything higher indicating depth to +which subtopic headers should be exposed, and negative numbers +indicating (negative of) the depth to which subtopic headers and +bodies should be exposed. + +The produced list can have two types of entries. Bare numbers +indicate points in the buffer where topic headers that should be +exposed reside. + + - bare negative numbers indicates that the topic starting at the + point which is the negative of the number should be opened, + including their entries. + - bare positive values indicate that this topic header should be + openned. + - Lists signify the beginning and end points of regions that should + be flagged, and the flag to employ. (For concealment: '\(\?r\)', and + exposure:" + (while spec + (cond ((listp spec) + ) + ) + (setq spec (cdr spec))) + ) + +;;;_ - Within Topic +;;;_ > outline-goto-prefix () (defun outline-goto-prefix () - " Put point at beginning of outline prefix for current topic, visible - or not. - - Returns a list of char address of the beginning of the prefix and the - end of it, or nil if none." - - (cond ((and (or (save-excursion (beginning-of-line) (bobp)) - (memq (preceding-char) '(?\n ?\^M))) - (looking-at outline-regexp)) - (setq outline-recent-prefix-end (match-end 0) - outline-recent-prefix-beginning - (goto-char (match-beginning 0)))) - ((re-search-backward outline-line-boundary-regexp - ;; unbounded search, - ;; stay at limit and return nil if failed: - nil 1) - (setq outline-recent-prefix-end (match-end 2) - outline-recent-prefix-beginning - (goto-char (match-beginning 2)))) - ;; We should be at the beginning of the buffer if the last - ;; condition failed. line-boundary-regexp doesn't cover topic - ;; at bob - Check for it. - ((looking-at outline-regexp) - (setq outline-recent-prefix-end (match-end 0) - outline-recent-prefix-beginning - (goto-char (match-beginning 0))))) - ) -;;;_ > outline-end-of-prefix () -(defun outline-end-of-prefix () - " Position cursor at beginning of header text." + "Put point at beginning of outline prefix for immediately containing topic. + +Goes to first subsequent topic if none immediately containing. + +Not sensitive to topic visibility. + +Returns a the point at the beginning of the prefix, or nil if none." + + (let (done) + (while (and (not done) + (re-search-backward "[\n\r]" nil 1)) + (forward-char 1) + (if (looking-at outline-regexp) + (setq done (outline-prefix-data (match-beginning 0) + (match-end 0))) + (forward-char -1))) + (if (bobp) + (cond ((looking-at outline-regexp) + (outline-prefix-data (match-beginning 0)(match-end 0))) + ((outline-next-heading) + (outline-prefix-data (match-beginning 0)(match-end 0))) + (done)) + done))) +;;;_ > outline-end-of-prefix () +(defun outline-end-of-prefix (&optional ignore-decorations) + "Position cursor at beginning of header text. + +If optional IGNORE-DECORATIONS is non-nil, put just after bullet, +otherwise skip white space between bullet and ensuing text." + (if (not (outline-goto-prefix)) nil (let ((match-data (match-data))) (goto-char (match-end 0)) - (while (looking-at "[0-9]") (forward-char 1)) - (if (and (not (eolp)) (looking-at "\\s-")) (forward-char 1)) + (if ignore-decorations + t + (while (looking-at "[0-9]") (forward-char 1)) + (if (and (not (eolp)) (looking-at "\\s-")) (forward-char 1))) (store-match-data match-data)) ;; Reestablish where we are: - (outline-current-depth)) - ) -;;;_ > outline-back-to-current-heading () + (outline-current-depth))) +;;;_ > outline-current-bullet-pos () +(defun outline-current-bullet-pos () + "Return position of current \(visible) topic's bullet." + + (if (not (outline-current-depth)) + nil + (1- (match-end 0)))) +;;;_ > outline-back-to-current-heading () (defun outline-back-to-current-heading () - " Move to heading line of current visible topic, or beginning of heading - if already on visible heading line." + "Move to heading line of current topic, or beginning if already on the line." + (beginning-of-line) (prog1 (or (outline-on-current-heading-p) (and (re-search-backward (concat "^\\(" outline-regexp "\\)") nil 'move) - (setq outline-recent-prefix-end (match-end 1) - outline-recent-prefix-beginning (match-beginning 1)))) - (if (interactive-p) (outline-end-of-prefix)) - ) - ) -;;;_ > outline-pre-next-preface () + (outline-prefix-data (match-beginning 1)(match-end 1)))) + (if (interactive-p) (outline-end-of-prefix)))) +;;;_ > outline-pre-next-preface () (defun outline-pre-next-preface () "Skip forward to just before the next heading line. - Returns that character position." +Returns that character position." (if (re-search-forward outline-line-boundary-regexp nil 'move) - (progn (goto-char (match-beginning 0)) - (setq outline-recent-prefix-end (match-end 2) - outline-recent-prefix-beginning (match-beginning 2)))) - ) -;;;_ > outline-end-of-current-subtree () + (prog1 (goto-char (match-beginning 0)) + (outline-prefix-data (match-beginning 2)(match-end 2))))) +;;;_ > outline-end-of-current-subtree () (defun outline-end-of-current-subtree () - " Put point at the end of the last leaf in the currently visible topic." + "Put point at the end of the last leaf in the currently visible topic." (interactive) (outline-back-to-current-heading) - (let ((opoint (point)) - (level (outline-recent-depth))) + (let ((level (outline-recent-depth))) (outline-next-heading) (while (and (not (eobp)) (> (outline-recent-depth) level)) (outline-next-heading)) - (if (not (eobp)) (forward-char -1)) - (if (memq (preceding-char) '(?\n ?\^M)) (forward-char -1)))) -;;;_ > outline-beginning-of-current-entry () + (and (not (eobp)) (forward-char -1)) + (and (memq (preceding-char) '(?\n ?\^M)) + (memq (aref (buffer-substring (max 1 (- (point) 3)) (point)) 1) + '(?\n ?\^M)) + (forward-char -1)) + (setq outline-recent-end-of-subtree (point)))) +;;;_ > outline-beginning-of-current-entry () (defun outline-beginning-of-current-entry () - " Position the point at the beginning of the body of the current topic." + "When not already there, position point at beginning of current topic's body. + +If already there, move cursor to bullet for hot-spot operation. +\(See outline-mode doc string for details on hot-spot operation.)" (interactive) - (outline-end-of-prefix)) -;;;_ > outline-beginning-of-current-entry () + (let ((start-point (point))) + (outline-end-of-prefix) + (if (and (interactive-p) + (= (point) start-point)) + (goto-char (outline-current-bullet-pos))))) +;;;_ > outline-end-of-current-entry () (defun outline-end-of-current-entry () - " Position the point at the end of the current topic's entry." + "Position the point at the end of the current topics' entry." (interactive) (outline-show-entry) (prog1 (outline-pre-next-preface) (if (and (not (bobp))(looking-at "^$")) - (forward-char -1))) -) + (forward-char -1)))) -;;;_ : Depth-wise -;;;_ > outline-ascend-to-depth (depth) +;;;_ - Depth-wise +;;;_ > outline-ascend-to-depth (depth) (defun outline-ascend-to-depth (depth) - " Ascend to depth DEPTH, returning depth if successful, nil if not." + "Ascend to depth DEPTH, returning depth if successful, nil if not." (if (and (> depth 0)(<= depth (outline-depth))) (let ((last-good (point))) (while (and (< depth (outline-depth)) @@ -1171,13 +1680,12 @@ of the parent topic." depth) (goto-char last-good) nil)) - (if (interactive-p) (outline-end-of-prefix)) - ) - ) -;;;_ > outline-descend-to-depth (depth) + (if (interactive-p) (outline-end-of-prefix)))) +;;;_ > outline-descend-to-depth (depth) (defun outline-descend-to-depth (depth) - " Descend to depth DEPTH within current topic, returning depth if - successful, nil if not." + "Descend to depth DEPTH within current topic. + +Returning depth if successful, nil if not." (let ((start-point (point)) (start-depth (outline-depth))) (while @@ -1191,413 +1699,484 @@ of the parent topic." (goto-char start-point) nil)) ) -;;;_ > outline-up-current-level (arg &optional dont-complain) +;;;_ > outline-up-current-level (arg &optional dont-complain) (defun outline-up-current-level (arg &optional dont-complain) - " Move to the heading line of which the present line is a subheading. - With argument, move up ARG levels. Don't return an error if - second, optional argument DONT-COMPLAIN, is non-nil." + "Move out ARG levels from current visible topic. + +Positions on heading line of containing topic. Error if unable to +ascend that far, or nil if unable to ascend but optional arg +DONT-COMPLAIN is non-nil." (interactive "p") (outline-back-to-current-heading) - (let ((present-level (outline-recent-depth))) + (let ((present-level (outline-recent-depth)) + (last-good (point)) + failed + return) ;; Loop for iterating arg: (while (and (> (outline-recent-depth) 1) (> arg 0) - (not (bobp))) + (not (bobp)) + (not failed)) + (setq last-good (point)) ;; Loop for going back over current or greater depth: (while (and (not (< (outline-recent-depth) present-level)) - (outline-previous-visible-heading 1))) + (or (outline-previous-visible-heading 1) + (not (setq failed present-level))))) (setq present-level (outline-current-depth)) (setq arg (- arg 1))) - ) - (prog1 (if (<= arg 0) - outline-recent-prefix-beginning - (if (interactive-p) (outline-end-of-prefix)) - (if (not dont-complain) - (error "Can't ascend past outermost level."))) - (if (interactive-p) (outline-end-of-prefix))) - ) - -;;;_ : Linear -;;;_ > outline-next-visible-heading (arg) -(defun outline-next-visible-heading (arg) - " Move to the next visible heading line. - - With argument, repeats, backward if negative." - (interactive "p") - (if (< arg 0) (beginning-of-line) (end-of-line)) - (if (re-search-forward (concat "^\\(" outline-regexp "\\)") - nil - 'go - arg) - (progn (outline-end-of-prefix) - (setq outline-recent-prefix-end (match-end 1) - outline-recent-prefix-beginning (match-beginning 1)))) - ) -;;;_ > outline-previous-visible-heading (arg) -(defun outline-previous-visible-heading (arg) - " Move to the previous heading line. - - With argument, repeats or can move forward if negative. - A heading line is one that starts with a `*' (or that outline-regexp - matches)." - (interactive "p") - (outline-next-visible-heading (- arg)) - ) -;;;_ > outline-next-heading (&optional backward) -(defun outline-next-heading (&optional backward) - " Move to the heading for the topic (possibly invisible) before this one. - - Optional arg BACKWARD means search for most recent prior heading. - - Returns the location of the heading, or nil if none found." - - (if (and backward (bobp)) - nil - (if backward (outline-goto-prefix) - (if (and (bobp) (not (eobp))) - (forward-char 1))) - - (if (if backward - ;; searches are unbounded and return nil if failed: - (or (re-search-backward outline-line-boundary-regexp - nil - 0) - (looking-at outline-bob-regexp)) - (re-search-forward outline-line-boundary-regexp - nil - 0)) - (progn;; Got some valid location state - set vars: - (setq outline-recent-prefix-end - (or (match-end 2) outline-recent-prefix-end)) - (goto-char (setq outline-recent-prefix-beginning - (or (match-beginning 2) - outline-recent-prefix-beginning)))) - ) - ) - ) -;;;_ > outline-previous-heading () -(defun outline-previous-heading () - " Move to the next (possibly invisible) heading line. - - Optional repeat-count arg means go that number of headings. + (if (or failed + (> arg 0)) + (progn (goto-char last-good) + (if (interactive-p) (outline-end-of-prefix)) + (if (not dont-complain) + (error "Can't ascend past outermost level.") + (if (interactive-p) (outline-end-of-prefix)) + nil)) + (if (interactive-p) (outline-end-of-prefix)) + outline-recent-prefix-beginning))) - Return the location of the beginning of the heading, or nil if not found." +;;;_ - Linear +;;;_ > outline-next-sibling (&optional depth backward) +(defun outline-next-sibling (&optional depth backward) + "Like outline-forward-current-level, but respects invisible topics. - (outline-next-heading t) - ) -;;;_ > outline-next-sibling (&optional backward) -(defun outline-next-sibling (&optional backward) - " Like outline-forward-current-level, but respects invisible topics. +Traverse at optional DEPTH, or current depth if none specified. - Go backward if optional arg BACKWARD is non-nil. +Go backward if optional arg BACKWARD is non-nil. - Return depth if successful, nil otherwise." +Return depth if successful, nil otherwise." (if (and backward (bobp)) nil - (let ((start-depth (outline-depth)) + (let ((start-depth (or depth (outline-depth))) (start-point (point)) - last-good) + last-depth) (while (and (not (if backward (bobp) (eobp))) (if backward (outline-previous-heading) (outline-next-heading)) - (> (outline-recent-depth) start-depth))) + (> (setq last-depth (outline-recent-depth)) start-depth))) (if (and (not (eobp)) - (and (> (outline-depth) 0) + (and (> (or last-depth (outline-depth)) 0) (= (outline-recent-depth) start-depth))) outline-recent-prefix-beginning (goto-char start-point) - nil) - ) - ) - ) -;;;_ > outline-previous-sibling (&optional arg) -(defun outline-previous-sibling (&optional arg) - " Like outline-forward-current-level, but goes backwards and respects - invisible topics. + (if depth (outline-depth) start-depth) + nil)))) +;;;_ > outline-previous-sibling (&optional depth backward) +(defun outline-previous-sibling (&optional depth backward) + "Like outline-forward-current-level,but backwards & respect invisible topics. - Optional repeat count means go number backward. +Optional DEPTH specifies depth to traverse, default current depth. - Note that the beginning of a level is (currently) defined by this - implementation to be the first of previous successor topics of - equal or greater depth. +Optional BACKWARD reverses direction. - Return depth if successful, nil otherwise." - (outline-next-sibling t) +Return depth if successful, nil otherwise." + (outline-next-sibling depth (not backward)) ) -;;;_ > outline-beginning-of-level () +;;;_ > outline-snug-back () +(defun outline-snug-back () + "Position cursor at end of previous topic + +Presumes point is at the start of a topic prefix." + (if (or (bobp) (eobp)) + nil + (forward-char -1)) + (if (or (bobp) (not (memq (preceding-char) '(?\n ?\^M)))) + nil + (forward-char -1) + (if (or (bobp) (not (memq (preceding-char) '(?\n ?\^M)))) + (forward-char -1))) + (point)) +;;;_ > outline-beginning-of-level () (defun outline-beginning-of-level () - " Go back to the first sibling at this level, visible or not." + "Go back to the first sibling at this level, visible or not." (outline-end-of-level 'backward)) -;;;_ > outline-end-of-level (&optional backward) +;;;_ > outline-end-of-level (&optional backward) (defun outline-end-of-level (&optional backward) - " Go to the last sibling at this level, visible or not." - - (while (outline-previous-sibling)) - (prog1 (outline-recent-depth) - (if (interactive-p) (outline-end-of-prefix))) -) -;;;_ > outline-forward-current-level (arg &optional backward) -(defun outline-forward-current-level (arg &optional backward) - " Position the point at the next heading of the same level, taking - optional repeat-count. - - Returns that position, else nil if is not found." - (interactive "p") - (outline-back-to-current-heading) - (let ((amt (if arg (if (< arg 0) - ;; Negative arg - invert direction. - (progn (setq backward (not backward)) - (abs arg)) - arg);; Positive arg - just use it. - 1)));; No arg - use 1: - (while (and (> amt 0) - (outline-next-sibling backward)) - (setq amt (1- amt))) - (if (interactive-p) (outline-end-of-prefix)) - (if (> amt 0) - (error "This is the %s topic on level %d." - (if backward "first" "last") - (outline-current-depth)) - t) - ) - ) -;;;_ > outline-backward-current-level (arg) -(defun outline-backward-current-level (arg) - " Position the point at the previous heading of the same level, taking - optional repeat-count. + "Go to the last sibling at this level, visible or not." - Returns that position, else nil if is not found." - (interactive "p") - (unwind-protect - (outline-forward-current-level arg t) - (outline-end-of-prefix)) -) + (let ((depth (outline-depth))) + (while (outline-previous-sibling depth nil)) + (prog1 (outline-recent-depth) + (if (interactive-p) (outline-end-of-prefix))))) +;;;_ > outline-next-visible-heading (arg) +(defun outline-next-visible-heading (arg) + "Move to the next ARG'th visible heading line, backward if arg is negative. -;;;_ : Search with Dynamic Exposure (requires isearch-mode) -;;;_ = outline-search-reconceal -(defvar outline-search-reconceal nil - "Used for outline isearch provisions, to track whether current search -match was concealed outside of search. The value is the location of the -match, if it was concealed, regular if the entire topic was concealed, in -a list if the entry was concealed.") -;;;_ = outline-search-quitting -(defconst outline-search-quitting nil - "Variable used by isearch-terminate/outline-provisions and -isearch-done/outline-provisions to distinguish between a conclusion -and cancellation of a search.") +Move as far as possible in indicated direction \(beginning or end of +buffer\) if headings are exhausted." -;;;_ > outline-enwrap-isearch () -(defun outline-enwrap-isearch () - " Impose isearch-mode wrappers so isearch progressively exposes and - reconceals hidden topics when working in outline mode, but works - elsewhere. + (interactive "p") + (let* ((backward (if (< arg 0) (setq arg (* -1 arg)))) + (step (if backward -1 1)) + (start-point (point)) + prev got) + + (while (> arg 0) ; limit condition + (while (and (not (if backward (bobp)(eobp))) ; boundary condition + ;; Move, skipping over all those concealed lines: + (< -1 (forward-line step)) + (not (setq got (looking-at outline-regexp))))) + ;; Register this got, it may be the last: + (if got (setq prev got)) + (setq arg (1- arg))) + (cond (got ; Last move was to a prefix: + (outline-prefix-data (match-beginning 0) (match-end 0)) + (outline-end-of-prefix)) + (prev ; Last move wasn't, but prev was: + (outline-prefix-data (match-beginning 0) (match-end 0))) + ((not backward) (end-of-line) nil)))) +;;;_ > outline-previous-visible-heading (arg) +(defun outline-previous-visible-heading (arg) + "Move to the previous heading line. - The function checks to ensure that the rebindings are done only once." +With argument, repeats or can move forward if negative. +A heading line is one that starts with a `*' (or that outline-regexp +matches)." + (interactive "p") + (outline-next-visible-heading (- arg))) +;;;_ > outline-forward-current-level (arg) +(defun outline-forward-current-level (arg) + "Position point at the next heading of the same level. - ; Should isearch-mode be employed, - (if (or (not outline-enwrap-isearch-mode) - ; or are preparations already done? - (fboundp 'real-isearch-terminate)) +Takes optional repeat-count, goes backward if count is negative. - ;; ... no - skip this all: +Returns resulting position, else nil if none found." + (interactive "p") + (let ((start-depth (outline-current-depth)) + (start-point (point)) + (start-arg arg) + (backward (> 0 arg)) + last-depth + (last-good (point)) + at-boundary) + (if (= 0 start-depth) + (error "No siblings, not in a topic...")) + (if backward (setq arg (* -1 arg))) + (while (not (or (zerop arg) + at-boundary)) + (while (and (not (if backward (bobp) (eobp))) + (if backward (outline-previous-visible-heading 1) + (outline-next-visible-heading 1)) + (> (setq last-depth (outline-recent-depth)) start-depth))) + (if (and last-depth (= last-depth start-depth) + (not (if backward (bobp) (eobp)))) + (setq last-good (point) + arg (1- arg)) + (setq at-boundary t))) + (if (and (not (eobp)) + (= arg 0) + (and (> (or last-depth (outline-depth)) 0) + (= (outline-recent-depth) start-depth))) + outline-recent-prefix-beginning + (goto-char last-good) + (if (not (interactive-p)) + nil + (outline-end-of-prefix) + (error "Hit %s level %d topic, traversed %d of %d requested." + (if backward "first" "last") + (outline-recent-depth) + (- (abs start-arg) arg) + (abs start-arg)))))) +;;;_ > outline-backward-current-level (arg) +(defun outline-backward-current-level (arg) + "Inverse of `outline-forward-current-level'." + (interactive "p") + (if (interactive-p) + (let ((current-prefix-arg (* -1 arg))) + (call-interactively 'outline-forward-current-level)) + (outline-forward-current-level (* -1 arg)))) + +;;;_ #5 Alteration + +;;;_ - Fundamental +;;;_ > outline-before-change-protect (beg end) +(defun outline-before-change-protect (beg end) + "Outline before-change hook, regulates changes to concealed text. + +Reveal concealed text that would be changed by current command, and +offer user choice to commit or forego the change. Unchanged text is +reconcealed. User has option to have changed text reconcealed. + +Undo commands are specially treated - the user is not prompted for +choice, the undoes are always committed (based on presumption that the +things being undone were already subject to this regulation routine), +and undoes always leave the changed stuff exposed. + +Changes to concealed regions are ignored while file is being written. +\(This is for the sake of functions that do change the file during +writes, like crypt and zip modes.) + +Locally bound in outline buffers to 'before-change-function', which +in emacs 19 is run before any change to the buffer. (Has no effect +in Emacs 18, which doesn't support before-change-function.) + +Any functions which set ['this-command' to 'undo', or which set] +'outline-override-protect' non-nil (as does, eg, outline-flag-chars) +are exempt from this restriction." + (if (and (outline-mode-p) + ; outline-override-protect + ; set by functions that know what + ; they're doing, eg outline internals: + (not outline-override-protect) + (not outline-during-write-cue) + (save-match-data ; Preserve operation position state. + ; Both beginning and end chars must + ; be exposed: + (save-excursion (if (memq this-command '(newline open-line)) + ;; Compensate for stupid emacs {new, + ;; open-}line display optimization: + (setq beg (1+ beg) + end (1+ end))) + (goto-char beg) + (or (outline-hidden-p) + (and (not (= beg end)) + (goto-char end) + (outline-hidden-p)))))) + (save-match-data + (if (equal this-command 'undo) + ;; Allow undo without inhibition. + ;; - Undoing new and open-line hits stupid emacs redisplay + ;; optimization (em 19 cmds.c, ~ line 200). + ;; - Presumably, undoing what was properly protected when + ;; done. + ;; - Undo may be users' only recourse in protection faults. + ;; So, expose what getting changed: + (progn (message "Undo! - exposing concealed target...") + (if (outline-hidden-p) + (outline-show-children)) + (message "Undo!")) + (let (response + (rehide-completely (save-excursion (outline-goto-prefix) + (outline-hidden-p))) + rehide-place) + + (save-excursion + (if (condition-case err + ;; Condition case to catch keyboard quits during reads. + (progn + ; Give them a peek where + (save-excursion + (if (eolp) (setq rehide-place + (outline-goto-prefix))) + (outline-show-entry)) + ; Present the message, but... + ; leave the cursor at the location + ; until they respond: + ; Then interpret the response: + (while + (progn + (message (concat "Change inside concealed" + " region - do it? " + "(n or 'y'/'r'eclose)")) + (setq response (read-char)) + (not + (cond ((memq response '(?r ?R)) + (setq response 'reclose)) + ((memq response '(?y ?Y ? )) + (setq response t)) + ((memq response '(?n ?N 127)) + (setq response nil) + t) + ((eq response ??) + (message + "'r' means 'yes, then reclose") + nil) + (t (message "Please answer y, n, or r") + (sit-for 1) + nil))))) + response) + (quit nil)) + ; Continue: + (if (eq response 'reclose) + (save-excursion + (if rehide-place (goto-char rehide-place)) + (if rehide-completely + (outline-hide-current-entry-completely) + (outline-hide-current-entry))) + (if (outline-ascend-to-depth (1- (outline-recent-depth))) + (outline-show-children) + (outline-show-to-offshoot))) + ; Prevent: + (if rehide-completely + (save-excursion + (if rehide-place (goto-char rehide-place)) + (outline-hide-current-entry-completely)) + (outline-hide-current-entry)) + (error (concat + "Change within concealed region prevented."))))))) + ) ; if + ) ; defun +;;;_ = outline-post-goto-bullet +(defvar outline-post-goto-bullet nil + "Outline internal var, for `outline-pre-command-business' hot-spot operation. + +When set, tells post-processing to reposition on topic bullet, and +then unset it. Set by outline-pre-command-business when implementing +hot-spot operation, where literal characters typed over a topic bullet +are mapped to the command of the corresponding control-key on the +outline-mode-map.") +(make-variable-buffer-local 'outline-post-goto-bullet) +;;;_ > outline-post-command-business () +(defun outline-post-command-business () + "Outline post-command-hook function. + +- Null outline-override-protect, so it's not left open. + +- Implement (and clear) outline-post-goto-bullet, for hot-spot + outline commands. + +- Massages buffer-undo-list so successive, standard character self-inserts are + aggregated. This kludge compensates for lack of undo bunching when + before-change-function is used." + + ; Apply any external change func: + (if (not (outline-mode-p)) ; In outline-mode. nil + (setq outline-override-protect nil) + (if outline-during-write-cue + ;; Was used by outline-before-change-protect, done with it now: + (setq outline-during-write-cue nil)) + ;; Undo bunching business: + (if (and (listp buffer-undo-list) ; Undo history being kept. + (equal this-command 'self-insert-command) + (equal last-command 'self-insert-command)) + (let* ((prev-stuff (cdr buffer-undo-list)) + (before-prev-stuff (cdr (cdr prev-stuff))) + cur-cell cur-from cur-to + prev-cell prev-from prev-to) + (if (and before-prev-stuff ; Goes back far enough to bother, + (not (car prev-stuff)) ; and break before current, + (not (car before-prev-stuff)) ; !and break before prev! + (setq prev-cell (car (cdr prev-stuff))) ; contents now, + (setq cur-cell (car buffer-undo-list)) ; contents prev. + + ;; cur contents denote a single char insertion: + (numberp (setq cur-from (car cur-cell))) + (numberp (setq cur-to (cdr cur-cell))) + (= 1 (- cur-to cur-from)) + + ;; prev contents denote fewer than aggregate-limit + ;; insertions: + (numberp (setq prev-from (car prev-cell))) + (numberp (setq prev-to (cdr prev-cell))) + ; Below threshold: + (> outline-undo-aggregation (- prev-to prev-from))) + (setq buffer-undo-list + (cons (cons prev-from cur-to) + (cdr (cdr (cdr buffer-undo-list)))))))) + ;; Implement -post-goto-bullet, if set: (must be after undo business) + (if (and outline-post-goto-bullet + (outline-current-bullet-pos)) + (progn (goto-char (outline-current-bullet-pos)) + (setq outline-post-goto-bullet nil))) + )) +;;;_ > outline-pre-command-business () +(defun outline-pre-command-business () + "Outline pre-command-hook function for outline buffers. + +Implements special behavior when cursor is on bullet char. + +Self-insert characters are reinterpreted control-character references +into the outline-mode-map. The outline-mode post-command hook will +position a cursor that has moved as a result of such reinterpretation, +on the destination topic's bullet, when the cursor wound up in the + +The upshot is that you can get easy, single (unmodified) key outline +maneuvering and general operations by positioning the cursor on the +bullet char, and it continues until you deliberately some non-outline +motion command to relocate the cursor off of a bullet char." - ;; ... yes: - - ; Ensure load of isearch-mode: - (if (or (and (fboundp 'isearch-mode) - (fboundp 'isearch-quote-char)) - (condition-case error - (load-library outline-enwrap-isearch-mode) - (file-error (message "Skipping isearch-mode provisions - %s '%s'" - (car (cdr error)) - (car (cdr (cdr error)))) - (sit-for 1) - ;; Inhibit subsequent tries and return nil: - (setq outline-enwrap-isearch-mode nil)))) - ;; Isearch-mode loaded, encapsulate specific entry points for - ;; outline dynamic-exposure business: - (progn - - ; stash crucial isearch-mode - ; funcs under known, private - ; names, then register wrapper - ; functions under the old - ; names, in their stead: - ; 'isearch-quit' is pre v 1.2: - (fset 'real-isearch-terminate - ; 'isearch-quit is pre v 1.2: - (or (if (fboundp 'isearch-quit) - (symbol-function 'isearch-quit)) - (if (fboundp 'isearch-abort) - ; 'isearch-abort' is v 1.2 and on: - (symbol-function 'isearch-abort)))) - (fset 'isearch-quit 'isearch-terminate/outline-provisions) - (fset 'isearch-abort 'isearch-terminate/outline-provisions) - (fset 'real-isearch-done (symbol-function 'isearch-done)) - (fset 'isearch-done 'isearch-done/outline-provisions) - (fset 'real-isearch-update (symbol-function 'isearch-update)) - (fset 'isearch-update 'isearch-update/outline-provisions) - (make-variable-buffer-local 'outline-search-reconceal)) - ) - ) - ) -;;;_ > outline-isearch-arrival-business () -(defun outline-isearch-arrival-business () - " Do outline business like exposing current point, if necessary, - registering reconcealment requirements in outline-search-reconceal - accordingly. - - Set outline-search-reconceal to nil if current point is not - concealed, to value of point if entire topic is concealed, and a - list containing point if only the topic body is concealed. - - This will be used to determine whether outline-hide-current-entry - or outline-hide-current-entry-completely will be necessary to - restore the prior concealment state." - - (if (and (boundp 'outline-mode) outline-mode) - (setq outline-search-reconceal - (if (outline-hidden-p) - (save-excursion - (if (re-search-backward outline-line-boundary-regexp nil 1) - ;; Nil value means we got to b-o-b - wouldn't need - ;; to advance. - (forward-char 1)) - ; We'll return point or list - ; containing point, depending - ; on concealment state of - ; topic prefix. - (prog1 (if (outline-hidden-p) (point) (list (point))) - ; And reveal the current - ; search target: - (outline-show-entry))))))) -;;;_ > outline-isearch-advancing-business () -(defun outline-isearch-advancing-business () - " Do outline business like deexposing current point, if necessary, - according to reconceal state registration." - (if (and (boundp 'outline-mode) outline-mode outline-search-reconceal) - (save-excursion - (if (listp outline-search-reconceal) - ;; Leave the topic visible: - (progn (goto-char (car outline-search-reconceal)) - (outline-hide-current-entry)) - ;; Rehide the entire topic: - (goto-char outline-search-reconceal) - (outline-hide-current-entry-completely)))) - ) -;;;_ > isearch-terminate/outline-provisions () -(defun isearch-terminate/outline-provisions () - (interactive) - (if (and (boundp 'outline-mode) - outline-mode - outline-enwrap-isearch-mode) - (outline-isearch-advancing-business)) - (let ((outline-search-quitting t) - (outline-search-reconceal nil)) - (real-isearch-terminate))) -;;;_ > isearch-done/outline-provisions () -(defun isearch-done/outline-provisions (&optional nopush) - (interactive) (if (and (boundp 'outline-mode) - outline-mode - outline-enwrap-isearch-mode) - (progn (save-excursion - (if (and outline-search-reconceal - (not (listp outline-search-reconceal))) - ;; The topic was concealed - reveal it, its siblings, - ;; and any ancestors that are still concealed: - (progn - (message "(exposing destination)")(sit-for 0) - ;; Ensure target topic's siblings are exposed: - (outline-ascend-to-depth (1- (outline-current-depth))) - ;; Ensure that the target topic's ancestors are exposed - (while (outline-hidden-p) - (outline-show-current-children)) - (outline-show-current-children) - (outline-show-current-entry))) - (outline-isearch-arrival-business)) - (if (not (and (boundp 'outline-search-quitting) - outline-search-quitting)) - (outline-show-current-children)))) - (if nopush - ;; isearch-done in newer version of isearch mode takes arg: - (real-isearch-done nopush) - (real-isearch-done))) -;;;_ > isearch-update/outline-provisions () -(defun isearch-update/outline-provisions () - " Wrapper around isearch which exposes and conceals hidden outline - portions encountered in the course of searching." - (if (not (and (boundp 'outline-mode) - outline-mode - outline-enwrap-isearch-mode)) - ;; Just do the plain business: - (real-isearch-update) - - ;; Ah - provide for outline conditions: - (outline-isearch-advancing-business) - (real-isearch-update) - (cond (isearch-success (outline-isearch-arrival-business)) - ((not isearch-success) (outline-isearch-advancing-business))) - ) - ) - -;;;_ #5 Manipulation - -;;;_ : Topic Format Assessment -;;;_ > outline-solicit-alternate-bullet (depth &optional current-bullet) + outline-mode + (eq this-command 'self-insert-command) + (eq (point)(outline-current-bullet-pos))) + + (let* ((this-key-num (if (numberp last-command-event) + last-command-event)) + mapped-binding) + + ; Map upper-register literals + ; to lower register: + (if (<= 96 this-key-num) + (setq this-key-num (- this-key-num 32))) + ; Check if we have a literal: + (if (and (<= 64 this-key-num) + (>= 96 this-key-num)) + (setq mapped-binding + (lookup-key 'outline-mode-map + (concat outline-command-prefix + (char-to-string (- this-key-num 64)))))) + (if mapped-binding + (setq outline-post-goto-bullet t + this-command mapped-binding))))) +;;;_ > outline-find-file-hook () +(defun outline-find-file-hook () + "Activate outline-mode when `outline-auto-activation' & `outline-layout' are non-nil. + +See `outline-init' for setup instructions." + (if (and outline-auto-activation + (not (outline-mode-p)) + outline-layout) + (outline-mode t))) +;;;_ : Establish the hooks +(add-hook 'post-command-hook 'outline-post-command-business) +(add-hook 'pre-command-hook 'outline-pre-command-business) + +;;;_ - Topic Format Assessment +;;;_ > outline-solicit-alternate-bullet (depth &optional current-bullet) (defun outline-solicit-alternate-bullet (depth &optional current-bullet) - " Prompt for and return a bullet char as an alternative to the - current one, but offer one suitable for current depth DEPTH - as default." + "Prompt for and return a bullet char as an alternative to the current one. + +Offer one suitable for current depth DEPTH as default." (let* ((default-bullet (or current-bullet (outline-bullet-for-depth depth))) + (sans-escapes (regexp-sans-escapes outline-bullets-string)) (choice (solicit-char-in-string (format "Select bullet: %s ('%s' default): " - outline-bullets-string + sans-escapes default-bullet) - (string-sans-char outline-bullets-string ?\\) + sans-escapes t))) (if (string= choice "") default-bullet choice)) ) -;;;_ > outline-sibling-index (&optional depth) +;;;_ > outline-sibling-index (&optional depth) (defun outline-sibling-index (&optional depth) - " Item number of this prospective topic among it's siblings. + "Item number of this prospective topic among its siblings. - If optional arg depth is greater than current depth, then we're - opening a new level, and return 0. +If optional arg depth is greater than current depth, then we're +opening a new level, and return 0. - If less than this depth, ascend to that depth and count..." +If less than this depth, ascend to that depth and count..." (save-excursion (cond ((and depth (<= depth 0) 0)) ((or (not depth) (= depth (outline-depth))) (let ((index 1)) - (while (outline-previous-sibling) (setq index (1+ index))) + (while (outline-previous-sibling (outline-recent-depth) nil) + (setq index (1+ index))) index)) ((< depth (outline-recent-depth)) (outline-ascend-to-depth depth) (outline-sibling-index)) (0)))) -;;;_ > outline-distinctive-bullet (bullet) +;;;_ > outline-distinctive-bullet (bullet) (defun outline-distinctive-bullet (bullet) - " True if bullet is one of those on outline-distinctive-bullets-string." + "True if bullet is one of those on outline-distinctive-bullets-string." (string-match (regexp-quote bullet) outline-distinctive-bullets-string)) -;;;_ > outline-numbered-type-prefix (&optional prefix) +;;;_ > outline-numbered-type-prefix (&optional prefix) (defun outline-numbered-type-prefix (&optional prefix) - " True if current header prefix bullet is numbered bullet." + "True if current header prefix bullet is numbered bullet." (and outline-numbered-bullet (string= outline-numbered-bullet (if prefix (outline-get-prefix-bullet prefix) (outline-get-bullet))))) -;;;_ > outline-bullet-for-depth (&optional depth) +;;;_ > outline-bullet-for-depth (&optional depth) (defun outline-bullet-for-depth (&optional depth) - " Return outline topic bullet suited to DEPTH, or for current depth if none - specified." + "Return outline topic bullet suited to optional DEPTH, or current depth." ;; Find bullet in plain-bullets-string modulo DEPTH. (if outline-stylish-prefixes (char-to-string (aref outline-plain-bullets-string @@ -1606,8 +2185,8 @@ and cancellation of a search.") outline-primary-bullet) ) -;;;_ : Topic Production -;;;_ > outline-make-topic-prefix (&optional prior-bullet +;;;_ - Topic Production +;;;_ > outline-make-topic-prefix (&optional prior-bullet (defun outline-make-topic-prefix (&optional prior-bullet new depth @@ -1618,47 +2197,47 @@ and cancellation of a search.") ;; opening a new topic after current topic, lower or higher, or we're ;; changing level of current topic. ;; Solicit dominates specified bullet-char. - " Generate a topic prefix suitable for optional arg DEPTH, or current - depth if not specified. - - All the arguments are optional. - - PRIOR-BULLET indicates the bullet of the prefix being changed, or - nil if none. This bullet may be preserved (other options - notwithstanding) if it is on the outline-distinctive-bullets-string, - for instance. - - Second arg NEW indicates that a new topic is being opened after the - topic at point, if non-nil. Default bullet for new topics, eg, may - be set (contingent to other args) to numbered bullets if previous - sibling is one. The implication otherwise is that the current topic - is being adjusted - shifted or rebulleted - and we don't consider - bullet or previous sibling. - - Third arg DEPTH forces the topic prefix to that depth, regardless of - the current topics' depth. - - Fourth arg SOLICIT non-nil provokes solicitation from the user of a - choice among the valid bullets. (This overrides other all the - options, including, eg, a distinctive PRIOR-BULLET.) - - Fifth arg, NUMBER-CONTROL, matters only if 'outline-numbered-bullet' - is non-nil *and* soliciting was not explicitly invoked. Then - NUMBER-CONTROL non-nil forces prefix to either numbered or - denumbered format, depending on the value of the sixth arg, INDEX. - - (Note that NUMBER-CONTROL does *not* apply to level 1 topics. Sorry...) - - If NUMBER-CONTROL is non-nil and sixth arg INDEX is non-nil then - the prefix of the topic is forced to be numbered. Non-nil - NUMBER-CONTROL and nil INDEX forces non-numbered format on the - bullet. Non-nil NUMBER-CONTROL and non-nil, non-number INDEX means - that the index for the numbered prefix will be derived, by counting - siblings back to start of level. If INDEX is a number, then that - number is used as the index for the numbered prefix (allowing, eg, - sequential renumbering to not require this function counting back the - index for each successive sibling)." - +;;;_ . Doc string: + "Generate a topic prefix suitable for optional arg DEPTH, or current depth. + +All the arguments are optional. + +PRIOR-BULLET indicates the bullet of the prefix being changed, or +nil if none. This bullet may be preserved (other options +notwithstanding) if it is on the outline-distinctive-bullets-string, +for instance. + +Second arg NEW indicates that a new topic is being opened after the +topic at point, if non-nil. Default bullet for new topics, eg, may +be set (contingent to other args) to numbered bullets if previous +sibling is one. The implication otherwise is that the current topic +is being adjusted - shifted or rebulleted - and we don't consider +bullet or previous sibling. + +Third arg DEPTH forces the topic prefix to that depth, regardless of +the current topics' depth. + +Fourth arg SOLICIT non-nil provokes solicitation from the user of a +choice among the valid bullets. (This overrides other all the +options, including, eg, a distinctive PRIOR-BULLET.) + +Fifth arg, NUMBER-CONTROL, matters only if 'outline-numbered-bullet' +is non-nil *and* soliciting was not explicitly invoked. Then +NUMBER-CONTROL non-nil forces prefix to either numbered or +denumbered format, depending on the value of the sixth arg, INDEX. + +\(Note that NUMBER-CONTROL does *not* apply to level 1 topics. Sorry...) + +If NUMBER-CONTROL is non-nil and sixth arg INDEX is non-nil then +the prefix of the topic is forced to be numbered. Non-nil +NUMBER-CONTROL and nil INDEX forces non-numbered format on the +bullet. Non-nil NUMBER-CONTROL and non-nil, non-number INDEX means +that the index for the numbered prefix will be derived, by counting +siblings back to start of level. If INDEX is a number, then that +number is used as the index for the numbered prefix (allowing, eg, +sequential renumbering to not requre this function counting back the +index for each successive sibling)." +;;;_ . Code: ;; The options are ordered in likely frequence of use, most common ;; highest, least lowest. Ie, more likely to be doing prefix ;; adjustments than soliciting, and yet more than numbering. @@ -1705,10 +2284,10 @@ and cancellation of a search.") ((and outline-numbered-bullet number-control) (if (setq numbering (not (setq denumbering (not index)))) outline-numbered-bullet - (if (and current-bullet + (if (and prior-bullet (not (string= outline-numbered-bullet - current-bullet))) - current-bullet + prior-bullet))) + prior-bullet (outline-bullet-for-depth depth)))) ;;; Neither soliciting nor controlled numbering ;;; @@ -1752,34 +2331,35 @@ and cancellation of a search.") ((outline-sibling-index)))))) ) ) -;;;_ > open-topic (relative-depth &optional before) -(defun open-topic (relative-depth &optional before) - " Open a new topic at depth DEPTH. New topic is situated after current - one, unless optional flag BEFORE is non-nil, or unless current line - is complete empty (not even whitespace), in which case open is done - on current line. - - Nuances: - - - Creation of new topics is with respect to the visible topic - containing the cursor, regardless of intervening concealed ones. - - - New headers are generally created after/before the body of a - topic. However, they are created right at cursor location if the - cursor is on a blank line, even if that breaks the current topic - body. This is intentional, to provide a simple means for - deliberately dividing topic bodies. - - - Double spacing of topic lists is preserved. Also, the first - level two topic is created double-spaced (and so would be - subsequent siblings, if that's left intact). Otherwise, - single-spacing is used. - - - Creation of sibling or nested topics is with respect to the topic - you're starting from, even when creating backwards. This way you - can easily create a sibling in front of the current topic without - having to go to its preceding sibling, and then open forward - from there." +;;;_ > outline-open-topic (relative-depth &optional before) +(defun outline-open-topic (relative-depth &optional before) + "Open a new topic at depth DEPTH. + +New topic is situated after current one, unless optional flag BEFORE +is non-nil, or unless current line is complete empty (not even +whitespace), in which case open is done on current line. + +Nuances: + +- Creation of new topics is with respect to the visible topic + containing the cursor, regardless of intervening concealed ones. + +- New headers are generally created after/before the body of a + topic. However, they are created right at cursor location if the + cursor is on a blank line, even if that breaks the current topic + body. This is intentional, to provide a simple means for + deliberately dividing topic bodies. + +- Double spacing of topic lists is preserved. Also, the first + level two topic is created double-spaced (and so would be + subsequent siblings, if that's left intact). Otherwise, + single-spacing is used. + +- Creation of sibling or nested topics is with respect to the topic + you're starting from, even when creating backwards. This way you + can easily create a sibling in front of the current topic without + having to go to its preceeding sibling, and then open forward + from there." (let* ((depth (+ (outline-current-depth) relative-depth)) (opening-on-blank (if (looking-at "^\$") @@ -1801,8 +2381,7 @@ and cancellation of a search.") outline-numbered-bullet)))) (point))) dbl-space - doing-beginning - ) + doing-beginning) (if (not opening-on-blank) ; Positioning and vertical @@ -1811,12 +2390,16 @@ and cancellation of a search.") (progn (goto-char ref-topic) (setq dbl-space ; Determine double space action: - (or (and (not (> relative-depth 0)) - ;; not descending, + (or (and (<= relative-depth 0) ; not descending; + (save-excursion + ;; at b-o-b or preceeded by a blank line? + (or (> 0 (forward-line -1)) + (looking-at "^\\s-*$") + (bobp))) (save-excursion - ;; preceded by a blank line? - (forward-line -1) - (looking-at "^\\s-*$"))) + ;; succeeded by a blank line? + (outline-end-of-current-subtree) + (bolp))) (and (= ref-depth 1) (or before (= depth 1) @@ -1826,19 +2409,28 @@ and cancellation of a search.") (not (outline-pre-next-preface))))))) ; Position to prior heading, - ; if inserting backwards: - (if before (progn (outline-back-to-current-heading) + ; if inserting backwards, and + ; not going outwards: + (if (and before (>= relative-depth 0)) + (progn (outline-back-to-current-heading) (setq doing-beginning (bobp)) - (if (and (not (outline-previous-sibling)) - (not (bobp))) - (outline-previous-heading)))) + (if (not (bobp)) + (outline-previous-heading))) + (if (and before (bobp)) + (outline-unprotected (open-line 1)))) - (if (and (<= depth ref-depth) - (= ref-depth (outline-current-depth))) + (if (<= relative-depth 0) ;; Not going inwards, don't snug up: (if doing-beginning - (open-line (if dbl-space 2 1)) - (outline-end-of-current-subtree)) + (outline-unprotected (open-line (if dbl-space 2 1))) + (if before + (progn (end-of-line) + (outline-pre-next-preface) + (while (= ?\r (following-char)) + (forward-char 1)) + (if (not (looking-at "^$")) + (outline-unprotected (open-line 1)))) + (outline-end-of-current-subtree))) ;; Going inwards - double-space if first offspring is, ;; otherwise snug up. (end-of-line) ; So we skip any concealed progeny. @@ -1855,10 +2447,24 @@ and cancellation of a search.") (progn (forward-line -1) (looking-at "^\\s-*$")))) (progn (forward-line 1) - (open-line 1))) + (outline-unprotected (open-line 1)))) (end-of-line)) ;;(if doing-beginning (goto-char doing-beginning)) - (if (not (bobp)) (newline (if dbl-space 2 1))) + (if (not (bobp)) + (progn (if (and (not (> depth ref-depth)) + (not before)) + (outline-unprotected (open-line 1)) + (if (> depth ref-depth) + (outline-unprotected (newline 1)) + (if dbl-space + (outline-unprotected (open-line 1)) + (if (not before) + (outline-unprotected (newline 1)))))) + (if dbl-space + (outline-unprotected (newline 1))) + (if (and (not (eobp)) + (not (bolp))) + (forward-char 1)))) )) (insert-string (concat (outline-make-topic-prefix opening-numbered t @@ -1875,58 +2481,116 @@ and cancellation of a search.") t) (end-of-line) ) ) -;;;_ > open-subtopic (arg) -(defun open-subtopic (arg) - " Open new topic header at deeper level than the current one. - - Negative universal arg means to open deeper, but place the new topic - prior to the current one." +;;;_ . open-topic contingencies +;;;_ ; base topic - one from which open was issued +;;;_ , beginning char +;;;_ , amount of space before will be used, unless openning in place +;;;_ , end char will be used, unless opening before (and it still may) +;;;_ ; absolute depth of new topic +;;;_ ! insert in place - overrides most stuff +;;;_ ; relative depth of new re base +;;;_ ; before or after base topic +;;;_ ; spacing around topic, if any, prior to new topic and at same depth +;;;_ ; buffer boundaries - special provisions for beginning and end ob +;;;_ ; level 1 topics have special provisions also - double space. +;;;_ ; location of new topic +;;;_ . +;;;_ > outline-open-subtopic (arg) +(defun outline-open-subtopic (arg) + "Open new topic header at deeper level than the current one. + +Negative universal arg means to open deeper, but place the new topic +prior to the current one." (interactive "p") - (open-topic 1 (> 0 arg))) -;;;_ > open-sibtopic (arg) -(defun open-sibtopic (arg) - " Open new topic header at same level as the current one. Negative - universal arg means to place the new topic prior to the current - one." - (interactive "p") - (open-topic 0 (> 0 arg))) -;;;_ > open-supertopic (arg) -(defun open-supertopic (arg) - " Open new topic header at shallower level than the current one. - Negative universal arg means to open shallower, but place the new - topic prior to the current one." + (outline-open-topic 1 (> 0 arg))) +;;;_ > outline-open-sibtopic (arg) +(defun outline-open-sibtopic (arg) + "Open new topic header at same level as the current one. +Negative universal arg means to place the new topic prior to the current +one." (interactive "p") - (open-topic -1 (> 0 arg))) + (outline-open-topic 0 (> 0 arg))) +;;;_ > outline-open-supertopic (arg) +(defun outline-open-supertopic (arg) + "Open new topic header at shallower level than the current one. -;;;_ : Outline Alteration -;;;_ . Topic Form Modification -;;;_ > outline-reindent-body (old-depth new-depth) -(defun outline-reindent-body (old-depth new-depth) - " Reindent body lines which were indented at old-depth to new-depth. +Negative universal arg means to open shallower, but place the new +topic prior to the current one." - Note that refill of indented paragraphs is not done, and tabs are - not accommodated. ('untabify' your outline if you want to preserve - hanging body indents.)" + (interactive "p") + (outline-open-topic -1 (> 0 arg))) + +;;;_ - Outline Alteration +;;;_ : Topic Modification +;;;_ = outline-former-auto-filler +(defvar outline-former-auto-filler nil + "Name of modal fill function being wrapped by outline-auto-fill.") +;;;_ > outline-auto-fill () +(defun outline-auto-fill () + "Outline-mode autofill function. + +Maintains outline hanging topic indentation if +`outline-use-hanging-indents' is set." + (let ((fill-prefix (if outline-use-hanging-indents + ;; Check for topic header indentation: + (save-excursion + (beginning-of-line) + (if (looking-at outline-regexp) + ;; ... construct indentation to account for + ;; length of topic prefix: + (make-string (progn (outline-end-of-prefix) + (current-column)) + ?\ )))))) + (if (or outline-former-auto-filler outline-use-hanging-indents) + (do-auto-fill)))) +;;;_ > outline-reindent-body (old-depth new-depth &optional number) +(defun outline-reindent-body (old-depth new-depth &optional number) + "Reindent body lines which were indented at old-depth to new-depth. + +Optional arg NUMBER indicates numbering is being added, and it must +be accomodated. + +Note that refill of indented paragraphs is not done." (save-excursion - (save-restriction - (outline-goto-prefix) - (forward-char 1) - (let* ((old-spaces-expr (make-string (1+ old-depth) ?\ )) - (new-spaces-expr (concat (make-string (1+ new-depth) ?\ ) - ;; spaces followed by non-space: - "\\1"))) - (while (and (re-search-forward "[\C-j\C-m]" nil t) - (not (looking-at outline-regexp))) - (if (looking-at old-spaces-expr) - (replace-match new-spaces-expr))))))) -;;;_ > outline-rebullet-current-heading (arg) + (outline-end-of-prefix) + (let* ((new-margin (current-column)) + excess old-indent-begin old-indent-end + curr-ind + ;; We want the column where the header-prefix text started + ;; *before* the prefix was changed, so we infer it relative + ;; to the new margin and the shift in depth: + (old-margin (+ old-depth (- new-margin new-depth)))) + + ;; Process lines up to (but excluding) next topic header: + (outline-unprotected + (save-match-data + (while + (and (re-search-forward "[\n\r]\\(\\s-*\\)" + nil + t) + ;; Register the indent data, before we reset the + ;; match data with a subsequent 'looking-at': + (setq old-indent-begin (match-beginning 1) + old-indent-end (match-end 1)) + (not (looking-at outline-regexp))) + (if (> 0 (setq excess (- (current-column) + old-margin))) + ;; Text starts left of old margin - don't adjust: + nil + ;; Text was hanging at or right of old left margin - + ;; reindent it, preserving its existing indentation + ;; beyond the old margin: + (delete-region old-indent-begin old-indent-end) + (indent-to (+ new-margin excess))))))))) +;;;_ > outline-rebullet-current-heading (arg) (defun outline-rebullet-current-heading (arg) - " Like non-interactive version 'outline-rebullet-heading', but work on - (only) visible heading containing point. + "Like non-interactive version 'outline-rebullet-heading'. + +But \(only\) affects visible heading containing point. - With repeat count, solicit for bullet." +With repeat count, solicit for bullet." (interactive "P") (save-excursion (outline-back-to-current-heading) (outline-end-of-prefix) @@ -1937,48 +2601,44 @@ and cancellation of a search.") t) ;;; do-successors ) ) -;;;_ > outline-rebullet-heading (&optional solicit ...) -(defvar current-bullet nil - "Variable local to outline-rebullet-heading,but referenced by -outline-make-topic-prefix, also. Should be resolved with explicitly -parameterized communication between the two, if suitable.") +;;;_ > outline-rebullet-heading (&optional solicit ...) (defun outline-rebullet-heading (&optional solicit new-depth number-control index do-successors) - " Adjust bullet of current topic prefix. + "Adjust bullet of current topic prefix. - All args are optional. +All args are optional. - If SOLICIT is non-nil then the choice of bullet is solicited from - user. Otherwise the distinctiveness of the bullet or the topic - depth determines it. +If SOLICIT is non-nil then the choice of bullet is solicited from +user. Otherwise the distinctiveness of the bullet or the topic +depth determines it. - Second arg DEPTH forces the topic prefix to that depth, regardless - of the topic's current depth. +Second arg DEPTH forces the topic prefix to that depth, regardless +of the topics current depth. - Third arg NUMBER-CONTROL can force the prefix to or away from - numbered form. It has effect only if 'outline-numbered-bullet' is - non-nil and soliciting was not explicitly invoked (via first arg). - Its effect, numbering or denumbering, then depends on the setting - of the forth arg, INDEX. +Third arg NUMBER-CONTROL can force the prefix to or away from +numbered form. It has effect only if 'outline-numbered-bullet' is +non-nil and soliciting was not explicitly invoked (via first arg). +Its effect, numbering or denumbering, then depends on the setting +of the forth arg, INDEX. - If NUMBER-CONTROL is non-nil and forth arg INDEX is nil, then the - prefix of the topic is forced to be non-numbered. Null index and - non-nil NUMBER-CONTROL forces denumbering. Non-nil INDEX (and - non-nil NUMBER-CONTROL) forces a numbered-prefix form. If non-nil - INDEX is a number, then that number is used for the numbered - prefix. Non-nil and non-number means that the index for the - numbered prefix will be derived by outline-make-topic-prefix. +If NUMBER-CONTROL is non-nil and forth arg INDEX is nil, then the +prefix of the topic is forced to be non-numbered. Null index and +non-nil NUMBER-CONTROL forces denumbering. Non-nil INDEX (and +non-nil NUMBER-CONTROL) forces a numbered-prefix form. If non-nil +INDEX is a number, then that number is used for the numbered +prefix. Non-nil and non-number means that the index for the +numbered prefix will be derived by outline-make-topic-prefix. - Fifth arg DO-SUCCESSORS t means re-resolve count on succeeding - siblings. +Fifth arg DO-SUCCESSORS t means re-resolve count on succeeding +siblings. - Cf vars 'outline-stylish-prefixes', 'outline-old-style-prefixes', - and 'outline-numbered-bullet', which all affect the behavior of - this function." +Cf vars 'outline-stylish-prefixes', 'outline-old-style-prefixes', +and 'outline-numbered-bullet', which all affect the behavior of +this function." (let* ((current-depth (outline-depth)) (new-depth (or new-depth current-depth)) @@ -1992,52 +2652,57 @@ parameterized communication between the two, if suitable.") number-control index))) - ;; Don't need to reinsert identical one: + ;; Is new one is identical to old? (if (and (= current-depth new-depth) (string= current-bullet (substring new-prefix (1- (length new-prefix))))) + ;; Nothing to do: t ;; New prefix probably different from old: - ;; get rid of old one: - (delete-region mb me) + ; get rid of old one: + (outline-unprotected (delete-region mb me)) (goto-char mb) - ;; Dispense with number if numbered-bullet prefix: + ; Dispense with number if + ; numbered-bullet prefix: (if (and outline-numbered-bullet (string= outline-numbered-bullet current-bullet) (looking-at "[0-9]+")) - (delete-region (match-beginning 0)(match-end 0))) + (outline-unprotected + (delete-region (match-beginning 0)(match-end 0)))) - ;; Put in new prefix: - (insert-string new-prefix) - ) + ; Put in new prefix: + (outline-unprotected (insert-string new-prefix)) - ;; Reindent the body if elected and depth changed: - (if (and outline-reindent-bodies - (not (= new-depth current-depth))) - (outline-reindent-body current-depth new-depth)) + ;; Reindent the body if elected and margin changed: + (if (and outline-reindent-bodies + (not (= new-depth current-depth))) + (outline-reindent-body current-depth new-depth)) - ;; Recursively rectify successive siblings if selected: - (if do-successors - (save-excursion - (while (outline-next-sibling) - (setq index - (cond ((numberp index) (1+ index)) - ((not number-control) (outline-sibling-index)))) - (if (outline-numbered-type-prefix) - (outline-rebullet-heading nil ;;; solicit - new-depth ;;; new-depth - number-control;;; number-control - index ;;; index - nil))))) ;;;(dont!)do-successors - ) - ) -;;;_ > outline-rebullet-topic (arg) + ;; Recursively rectify successive siblings of orig topic if + ;; caller elected for it: + (if do-successors + (save-excursion + (while (outline-next-sibling new-depth nil) + (setq index + (cond ((numberp index) (1+ index)) + ((not number-control) (outline-sibling-index)))) + (if (outline-numbered-type-prefix) + (outline-rebullet-heading nil ;;; solicit + new-depth ;;; new-depth + number-control;;; number-control + index ;;; index + nil))))) ;;;(dont!)do-successors + ) ; (if (and (= current-depth new-depth)...)) + ) ; let* ((current-depth (outline-depth))...) + ) ; defun +;;;_ > outline-rebullet-topic (arg) (defun outline-rebullet-topic (arg) - " Like outline-rebullet-topic-grunt, but start from topic visible at point. - Descends into invisible as well as visible topics, however. + "Like outline-rebullet-topic-grunt, but start from topic visible at point. + +Descends into invisible as well as visible topics, however. - With repeat count, shift topic depth by that amount." +With repeat count, shift topic depth by that amount." (interactive "P") (let ((start-col (current-column)) (was-eol (eolp))) @@ -2052,26 +2717,25 @@ parameterized communication between the two, if suitable.") (error "Attempt to shift topic below level 1")) (outline-rebullet-topic-grunt arg) (if (not (zerop arg)) (message "Shifting... done."))) - (move-to-column (max 0 (+ start-col arg)))) - ) -;;;_ > outline-rebullet-topic-grunt (&optional relative-depth ...) + (move-to-column (max 0 (+ start-col arg))))) +;;;_ > outline-rebullet-topic-grunt (&optional relative-depth ...) (defun outline-rebullet-topic-grunt (&optional relative-depth starting-depth starting-point index do-successors) - " Rebullet the topic at point, visible or invisible, and all - contained subtopics. See outline-rebullet-heading for rebulleting - behavior. + "Rebullet the topic at point, visible or invisible, and all +contained subtopics. See outline-rebullet-heading for rebulleting +behavior. - All arguments are optional. +All arguments are optional. - First arg RELATIVE-DEPTH means to shift the depth of the entire - topic that amount. +First arg RELATIVE-DEPTH means to shift the depth of the entire +topic that amount. - The rest of the args are for internal recursive use by the function - itself. The are STARTING-DEPTH, STARTING-POINT, and INDEX." +The rest of the args are for internal recursive use by the function +itself. The are STARTING-DEPTH, STARTING-POINT, and INDEX." (let* ((relative-depth (or relative-depth 0)) (new-depth (outline-depth)) @@ -2139,92 +2803,103 @@ parameterized communication between the two, if suitable.") (outline-rebullet-heading nil nil nil nil t))))) ) ) -;;;_ > outline-number-siblings (&optional denumber) +;;;_ > outline-renumber-to-depth (&optional depth) +(defun outline-renumber-to-depth (&optional depth) + "Renumber siblings at current depth. + +Affects superior topics if optional arg DEPTH is less than current depth. + +Returns final depth." + + ;; Proceed by level, processing subsequent siblings on each, + ;; ascending until we get shallower than the start depth: + + (let ((ascender (outline-depth))) + (while (and (not (eobp)) + (outline-depth) + (>= (outline-recent-depth) depth) + (>= ascender depth)) + ; Skip over all topics at + ; lesser depths, which can not + ; have been disturbed: + (while (and (not (eobp)) + (> (outline-recent-depth) ascender)) + (outline-next-heading)) + ; Prime ascender for ascension: + (setq ascender (1- (outline-recent-depth))) + (if (>= (outline-recent-depth) depth) + (outline-rebullet-heading nil ;;; solicit + nil ;;; depth + nil ;;; number-control + nil ;;; index + t))));;; do-successors + (outline-recent-depth)) +;;;_ > outline-number-siblings (&optional denumber) (defun outline-number-siblings (&optional denumber) - " Assign numbered topic prefix to this topic and its siblings. + "Assign numbered topic prefix to this topic and its siblings. - With universal argument, denumber - assign default bullet to this - topic and its siblings. +With universal argument, denumber - assign default bullet to this +topic and its siblings. - With repeated universal argument (`^U^U'), solicit bullet for each - rebulleting each topic at this level." +With repeated universal argument (`^U^U'), solicit bullet for each +rebulleting each topic at this level." (interactive "P") (save-excursion (outline-back-to-current-heading) (outline-beginning-of-level) - (let ((index (if (not denumber) 1)) + (let ((depth (outline-recent-depth)) + (index (if (not denumber) 1)) (use-bullet (equal '(16) denumber)) (more t)) (while more (outline-rebullet-heading use-bullet ;;; solicit - nil ;;; depth + depth ;;; depth t ;;; number-control index ;;; index nil) ;;; do-successors (if index (setq index (1+ index))) - (setq more (outline-next-sibling))) - ) - ) - ) -;;;_ > outline-shift-in (arg) + (setq more (outline-next-sibling depth nil)))))) +;;;_ > outline-shift-in (arg) (defun outline-shift-in (arg) - " Decrease prefix depth of current heading and any topics collapsed - within it." + "Increase depth of current heading and any topics collapsed within it." (interactive "p") (outline-rebullet-topic arg)) -;;;_ > outline-shift-out (arg) +;;;_ > outline-shift-out (arg) (defun outline-shift-out (arg) - " Decrease prefix depth of current heading and any topics collapsed - within it." + "Decrease depth of current heading and any topics collapsed within it." (interactive "p") (outline-rebullet-topic (* arg -1))) -;;;_ . Surgery (kill-ring) functions with special provisions for outlines: -;;;_ > outline-kill-line (&optional arg) +;;;_ : Surgery (kill-ring) functions with special provisions for outlines: +;;;_ > outline-kill-line (&optional arg) (defun outline-kill-line (&optional arg) - " Kill line, adjusting subsequent lines suitably for outline mode." + "Kill line, adjusting subsequent lines suitably for outline mode." (interactive "*P") - (if (not (and - (boundp 'outline-mode) outline-mode ; active outline mode, - outline-numbered-bullet ; numbers may need adjustment, - (bolp) ; may be clipping topic head, - (looking-at outline-regexp))) ; are clipping topic head. + (if (not (and (outline-mode-p) ; active outline mode, + outline-numbered-bullet ; numbers may need adjustment, + (bolp) ; may be clipping topic head, + (looking-at outline-regexp))) ; are clipping topic head. ;; Above conditions do not obtain - just do a regular kill: (kill-line arg) ;; Ah, have to watch out for adjustments: - (let* ((depth (outline-depth)) - (ascender depth)) + (let* ((depth (outline-depth))) + ; Do the kill: (kill-line arg) + ; Provide some feedback: (sit-for 0) (save-excursion + ; Start with the topic + ; following killed line: (if (not (looking-at outline-regexp)) (outline-next-heading)) - (if (> (outline-depth) depth) - ;; An intervening parent was removed from after a subtree: - (setq depth (outline-recent-depth))) - (while (and (> (outline-depth) 0) - (> (outline-recent-depth) ascender) - (outline-ascend-to-depth (setq ascender - (1- ascender))))) - ;; Have to try going forward until we find another at - ;; desired depth: - (if (and outline-numbered-bullet - (outline-descend-to-depth depth)) - (outline-rebullet-heading nil ;;; solicit - depth ;;; depth - nil ;;; number-control - nil ;;; index - t) ;;; do-successors - ) - ) - ) - ) - ) -;;;_ > outline-kill-topic () + (outline-renumber-to-depth depth))))) +;;;_ > outline-kill-topic () (defun outline-kill-topic () - " Kill topic together with subtopics." + "Kill topic together with subtopics. + +Leaves primary topic's trailing vertical whitespace, if any." ;; Some finagling is done to make complex topic kills appear faster ;; than they actually are. A redisplay is performed immediately @@ -2233,162 +2908,207 @@ parameterized communication between the two, if suitable.") ;; a lag *after* the kill has been performed. (interactive) - (let* ((beg (outline-back-to-current-heading)) + (let* ((beg (prog1 (outline-back-to-current-heading)(beginning-of-line))) (depth (outline-recent-depth))) (outline-end-of-current-subtree) (if (not (eobp)) - (forward-char 1)) + (if (or (not (looking-at "^$")) + ;; A blank line - cut it with this topic *unless* this + ;; is the last topic at this level, in which case + ;; we'll leave the blank line as part of the + ;; containing topic: + (save-excursion + (and (outline-next-heading) + (>= (outline-recent-depth) depth)))) + (forward-char 1))) + (kill-region beg (point)) (sit-for 0) (save-excursion - (if (and outline-numbered-bullet - (outline-descend-to-depth depth)) - (outline-rebullet-heading nil ;;; solicit - depth ;;; depth - nil ;;; number-control - nil ;;; index - t) ;;; do-successors - ) - ) - ) - ) -;;;_ > outline-yank (&optional arg) -(defun outline-yank (&optional arg) - " Like regular yank, except does depth adjustment of yanked topics, when: + (outline-renumber-to-depth depth)))) +;;;_ > outline-yank-processing () +(defun outline-yank-processing (&optional arg) + + "Incidental outline-specific business to be done just after text yanks. + +Does depth adjustment of yanked topics, when: - 1 the stuff being yanked starts with a valid outline header prefix, and - 2 it is being yanked at the end of a line which consists of only a valid +1 the stuff being yanked starts with a valid outline header prefix, and +2 it is being yanked at the end of a line which consists of only a valid topic prefix. - If these two conditions hold then the depth of the yanked topics - are all adjusted the amount it takes to make the first one at the - depth of the header into which it's being yanked. +Also, adjusts numbering of subsequent siblings when appropropriate. - The point is left in from of yanked, adjusted topics, rather than - at the end (and vice-versa with the mark). Non-adjusted yanks, - however, (ones that don't qualify for adjustment) are handled - exactly like normal yanks. +Depth adjustment alters the depth of all the topics being yanked +the amount it takes to make the first topic have the depth of the +header into which it's being yanked. - Outline-yank-pop is used with outline-yank just as normal yank-pop - is used with normal yank in non-outline buffers." +The point is left in front of yanked, adjusted topics, rather than +at the end (and vice-versa with the mark). Non-adjusted yanks, +however, are left exactly like normal, non-outline-specific yanks." + + (interactive "*P") + ; Get to beginning, leaving + ; region around subject: + (if (< (mark-marker) (point)) + (exchange-point-and-mark)) + (let* ((subj-beg (point)) + (subj-end (mark-marker)) + ;; 'resituate' if yanking an entire topic into topic header: + (resituate (and (outline-e-o-prefix-p) + (looking-at (concat "\\(" outline-regexp "\\)")) + (outline-prefix-data (match-beginning 1) + (match-end 1)))) + ;; 'rectify-numbering' if resituating (where several topics may + ;; be resituating) or yanking a topic into a topic slot (bol): + (rectify-numbering (or resituate + (and (bolp) (looking-at outline-regexp))))) + (if resituate + ; The yanked stuff is a topic: + (let* ((prefix-len (- (match-end 1) subj-beg)) + (subj-depth (outline-recent-depth)) + (prefix-bullet (outline-recent-bullet)) + (adjust-to-depth + ;; Nil if adjustment unnecessary, otherwise depth to which + ;; adjustment should be made: + (save-excursion + (and (goto-char subj-end) + (eolp) + (goto-char subj-beg) + (and (looking-at outline-regexp) + (progn + (beginning-of-line) + (not (= (point) subj-beg))) + (looking-at outline-regexp) + (outline-prefix-data (match-beginning 0) + (match-end 0))) + (outline-recent-depth)))) + done + (more t)) + (setq rectify-numbering outline-numbered-bullet) + (if adjust-to-depth + ; Do the adjustment: + (progn + (message "... yanking") (sit-for 0) + (save-restriction + (narrow-to-region subj-beg subj-end) + ; Trim off excessive blank + ; line at end, if any: + (goto-char (point-max)) + (if (looking-at "^$") + (outline-unprotected (delete-char -1))) + ; Work backwards, with each + ; shallowest level, + ; successively excluding the + ; last processed topic from + ; the narrow region: + (while more + (outline-back-to-current-heading) + ; go as high as we can in each bunch: + (while (outline-ascend-to-depth (1- (outline-depth)))) + (save-excursion + (outline-rebullet-topic-grunt (- adjust-to-depth + subj-depth)) + (outline-depth)) + (if (setq more (not (bobp))) + (progn (widen) + (forward-char -1) + (narrow-to-region subj-beg (point)))))) + (message "") + ;; Preserve new bullet if it's a distinctive one, otherwise + ;; use old one: + (if (string-match (regexp-quote prefix-bullet) + outline-distinctive-bullets-string) + ; Delete from bullet of old to + ; before bullet of new: + (progn + (beginning-of-line) + (delete-region (point) subj-beg) + (set-marker (mark-marker) subj-end) + (goto-char subj-beg) + (outline-end-of-prefix)) + ; Delete base subj prefix, + ; leaving old one: + (delete-region (point) (+ (point) + prefix-len + (- adjust-to-depth subj-depth))) + ; and delete residual subj + ; prefix digits and space: + (while (looking-at "[0-9]") (delete-char 1)) + (if (looking-at " ") (delete-char 1)))) + (exchange-point-and-mark)))) + (if rectify-numbering + (progn + (save-excursion + ; Give some preliminary feedback: + (message "... reconciling numbers") (sit-for 0) + ; ... and renumber, in case necessary: + (goto-char subj-beg) + (if (outline-goto-prefix) + (outline-rebullet-heading nil ;;; solicit + (outline-depth) ;;; depth + nil ;;; number-control + nil ;;; index + t)) + (message "")))) + (if (not resituate) + (exchange-point-and-mark)))) +;;;_ > outline-yank (&optional arg) +(defun outline-yank (&optional arg) + "Outline-mode yank, with depth and numbering adjustment of yanked topics. + +Non-topic yanks work no differntly than normal yanks. + +If a topic is being yanked into a bare topic prefix, the depth of the +yanked topic is adjusted to the depth of the topic prefix. + + 1 we're yanking in an outline-mode buffer + 2 the stuff being yanked starts with a valid outline header prefix, and + 3 it is being yanked at the end of a line which consists of only a valid + topic prefix. + +If these conditions hold then the depth of the yanked topics are all +adjusted the amount it takes to make the first one at the depth of the +header into which it's being yanked. + +The point is left in front of yanked, adjusted topics, rather than +at the end (and vice-versa with the mark). Non-adjusted yanks, +however, (ones that don't qualify for adjustment) are handled +exactly like normal yanks. + +Numbering of yanked topics, and the succesive siblings at the depth +into which they're being yanked, is adjusted. + +Outline-yank-pop works with outline-yank just like normal yank-pop +works with normal yank in non-outline buffers." (interactive "*P") (setq this-command 'yank) - (if (not (and (boundp 'outline-mode) outline-mode)) - - ;; Outline irrelevant - just do regular yank: - (yank arg) - - ;; Outline *is* relevant: - (let ((beginning (point)) - topic-yanked - established-depth) ; Depth of the prefix into which we're yanking. - ;; Get current depth and numbering ... Oops, not doing anything - ;; with the number just yet... - (if (and (eolp) - (save-excursion (beginning-of-line) - (looking-at outline-regexp))) - (setq established-depth (- (match-end 0) (match-beginning 0)))) - (yank arg) - (exchange-dot-and-mark) - (if (and established-depth ; the established stuff qualifies. - ;; The yanked stuff also qualifies - is topic(s): - (looking-at (concat "\\(" outline-regexp "\\)"))) - ;; Ok, adjust the depth of the yanked stuff. Note that the - ;; stuff may have more than a single root, so we have to - ;; iterate over all the top level ones yanked, and do them in - ;; such a way that the adjustment of one new one won't affect - ;; any of the other new ones. We use the focus of the - ;; narrowed region to successively exclude processed siblings. - (let* ((yanked-beg (match-beginning 1)) - (yanked-end (match-end 1)) - (yanked-bullet (buffer-substring (1- yanked-end) yanked-end)) - (yanked-depth (- yanked-end yanked-beg)) - (depth-diff (- established-depth yanked-depth)) - done - (more t)) - (setq topic-yanked t) - (save-excursion - (save-restriction - (narrow-to-region yanked-beg (mark)) - ;; First trim off excessive blank line at end, if any: - (goto-char (point-max)) - (if (looking-at "^$") (delete-char -1)) - (goto-char (point-min)) - ;; Work backwards, with each shallowest level, - ;; successively excluding the last processed topic - ;; from the narrow region: - (goto-char (point-max)) - (while more - (outline-back-to-current-heading) - ;; go as high as we can in each bunch: - (while (outline-ascend-to-depth - (1- (outline-depth)))) - (save-excursion - (outline-rebullet-topic-grunt depth-diff - (outline-depth) - (point))) - (if (setq more (not (bobp))) - (progn (widen) - (forward-char -1) - (narrow-to-region yanked-beg (point))))))) - ;; Preserve new bullet if it's a distinctive one, otherwise - ;; use old one: - (if (string-match yanked-bullet outline-distinctive-bullets-string) - (delete-region (save-excursion - (beginning-of-line) - (point)) - yanked-beg) - (delete-region yanked-beg (+ yanked-beg established-depth)) - ;; and extraneous digits and a space: - (while (looking-at "[0-9]") (delete-char 1)) - (if (looking-at " ") (delete-char 1)) - ) - (goto-char yanked-beg) - ) - ;; Not established-depth or looking-at... - (setq topic-yanked (looking-at outline-regexp)) - (exchange-dot-and-mark)) - (if (and topic-yanked outline-numbered-bullet) - (progn - ;; Renumber, in case necessary: - (sit-for 0) - (save-excursion - (goto-char beginning) - (if (outline-goto-prefix) - (outline-rebullet-heading nil ;;; solicit - (outline-depth) ;;; depth - nil ;;; number-control - nil ;;; index - t) ;;; do-successors - ) - ) - ) - ) - ) - ) - ) -;;;_ > outline-yank-pop (&optional arg) + (yank arg) + (if (outline-mode-p) + (outline-yank-processing))) +;;;_ > outline-yank-pop (&optional arg) (defun outline-yank-pop (&optional arg) - " Just like yank-pop, but works like outline-yank when popping - topics just after fresh outline prefixes. Adapts level of popped - stuff to level of fresh prefix." + "Yank-pop like outline-yank when popping to bare outline prefixes. + +Adapts level of popped topics to level of fresh prefix. + +Note - prefix changes to distinctive bullets will stick, if followed +by pops to non-distinctive yanks. Bug..." (interactive "*p") - (if (not (eq last-command 'yank)) - (error "Previous command was not a yank")) (setq this-command 'yank) - (delete-region (point) (mark)) - (rotate-yank-pointer arg) - (outline-yank) - ) + (yank-pop arg) + (if (outline-mode-p) + (outline-yank-processing))) -;;;_ : Specialty bullet functions -;;;_ . File Cross references -;;;_ > outline-resolve-xref () +;;;_ - Specialty bullet functions +;;;_ : File Cross references +;;;_ > outline-resolve-xref () (defun outline-resolve-xref () - " Pop to file associated with current heading, if it has an xref bullet - (according to setting of 'outline-file-xref-bullet')." + "Pop to file associated with current heading, if it has an xref bullet. + +\(Works according to setting of `outline-file-xref-bullet')." (interactive) (if (not outline-file-xref-bullet) (error @@ -2426,138 +3146,1093 @@ parameterized communication between the two, if suitable.") ) ) ) -;;;_ > outline-to-entry-end - Unmaintained compatibility - ignore this! -;------------------------------------------------------------------- -; Something added solely for use by a "smart menu" package someone got -; off the net. I have no idea whether this is appropriate code. - -(defvar next-entry-exists nil "Used by outline-to-entry-end, dunno why.") -(defun outline-to-entry-end (&optional include-sub-entries curr-entry-level) - " Go to end of whole entry if optional INCLUDE-SUB-ENTRIES is non-nil. - CURR-ENTRY-LEVEL is an integer representing the length of the current level - string which matched to 'outline-regexp'. If INCLUDE-SUB-ENTRIES is nil, - CURR-ENTRY-LEVEL is not needed." - (while (and (setq next-entry-exists - (re-search-forward outline-regexp nil t)) - include-sub-entries - (save-excursion - (beginning-of-line) - (> (outline-depth) curr-entry-level)))) - (if next-entry-exists - (progn (beginning-of-line) (point)) - (goto-char (point-max)))) -;;; Outline topic prefix and level adjustment funcs: - -;;;_ #6 miscellaneous -;;;_ > outline-copy-exposed (&optional workbuf) -(defun outline-copy-exposed (&optional workbuf) - " Duplicate buffer to other buffer, sans hidden stuff. - - Without repeat count, this simple-minded function just generates - the new buffer by concatenating the current buffer name with \" - exposed\", and doing a 'get-buffer' on it." + +;;;_ #6 Exposure Control and Processing + +;;;_ - Fundamental +;;;_ > outline-flag-region (from to flag) +(defmacro outline-flag-region (from to flag) + "Hide or show lines from FROM to TO, via emacs selective-display FLAG char. +Ie, text following flag C-m \(carriage-return) is hidden until the +next C-j (newline) char. + +Returns the endpoint of the region." + (` (let ((buffer-read-only nil) + (outline-override-protect t)) + (subst-char-in-region (, from) (, to) + (if (= (, flag) ?\n) ?\r ?\n) + (, flag) t)))) +;;;_ > outline-flag-current-subtree (flag) +(defun outline-flag-current-subtree (flag) + "Hide or show subtree of currently-visible topic. + +See `outline-flag-region' for more details." + + (save-excursion + (outline-back-to-current-heading) + (outline-flag-region (point) + (progn (outline-end-of-current-subtree) (1- (point))) + flag))) + +;;;_ - Mapping and processing of topics +;;;_ " See also chart functions, in navigation +;;;_ > outline-listify-exposed (&optional start end) +(defun outline-listify-exposed (&optional start end) + + "Produce a list representing exposed topics in current region. + +This list can then be used by 'outline-process-exposed' to manipulate +the subject region. + +List is composed of elements that may themselves be lists representing +exposed components in subtopic. + +Each component list contains: + - a number representing the depth of the topic, + - a string representing the header-prefix (ref. 'outline-header-prefix'), + - a string representing the bullet character, + - and a series of strings, each containing one line of the exposed + portion of the topic entry." + + (interactive "r") + (save-excursion + (let* (strings pad result depth bullet beg next done) ; State vars. + (goto-char start) + (beginning-of-line) + (if (not (outline-goto-prefix)) ; Get initial position within a topic: + (outline-next-visible-heading 1)) + (while (and (not done) + (not (eobp)) ; Loop until we've covered the region. + (not (> (point) end))) + (setq depth (outline-recent-depth) ; Current topics' depth, + bullet (outline-recent-bullet) ; ... bullet, + beg (progn (outline-end-of-prefix t) (point))) ; and beginning. + (setq done ; The boundary for the current topic: + (not (outline-next-visible-heading 1))) + (beginning-of-line) + (setq next (point)) + (goto-char beg) + (setq strings nil) + (while (> next (point)) ; Get all the exposed text in + (setq strings + (cons (buffer-substring + beg + ;To hidden text or end of line: + (progn + (search-forward "\r" + (save-excursion (end-of-line) + (point)) + 1) + (if (= (preceding-char) ?\r) + (1- (point)) + (point)))) + strings)) + (if (< (point) next) ; Resume from after hid text, if any. + (forward-line 1)) + (setq beg (point))) + ;; Accumulate list for this topic: + (setq result + (cons (append (list depth + outline-header-prefix + bullet) + (nreverse strings)) + result))) + ;; Put the list with first at front, to last at back: + (nreverse result)))) +;;;_ > outline-process-exposed (arg &optional tobuf) +(defun outline-process-exposed (&optional func from to frombuf tobuf) + "Map function on exposed parts of current topic; results to another buffer. + +Apply FUNCTION \(default 'outline-insert-listified) to exposed +portions FROM position TO position \(default region, or the entire +buffer if no region active) in buffer FROMBUF \(default current +buffer) to buffer TOBUF \(default is buffer named like frombuf but +with \"*\" prepended and \" exposed*\" appended). + +The function must as its arguments the elements of the list +representations of topic entries produced by outline-listify-exposed." + + ; Resolve arguments, + ; defaulting if necessary: + (if (not func) (setq func 'outline-insert-listified)) + (if (not (and from to)) + (if mark-active + (setq from (region-beginning) to (region-end)) + (setq from (point-min) to (point-max)))) + (if frombuf + (if (not (bufferp frombuf)) + ;; Specified but not a buffer - get it: + (let ((got (get-buffer frombuf))) + (if (not got) + (error (concat "outline-process-exposed: source buffer " + frombuf + " not found.")) + (setq frombuf got)))) + ;; not specified - default it: + (setq frombuf (current-buffer))) + (if tobuf + (if (not (bufferp tobuf)) + (setq tobuf (get-buffer-create tobuf))) + ;; not specified - default it: + (setq tobuf (concat "*" (buffer-name frombuf) " exposed*"))) + + (let* ((listified (progn (set-buffer frombuf) + (outline-listify-exposed from to))) + (prefix outline-header-prefix) ; ... as set in frombuf. + curr) + (set-buffer tobuf) + (while listified + (setq curr (car listified)) + (setq listified (cdr listified)) + (apply func (list (car curr) ; depth + (car (cdr curr)) ; header-prefix + (car (cdr (cdr curr))) ; bullet + (cdr (cdr (cdr curr)))))) ; list of text lines + (pop-to-buffer tobuf))) + +;;;_ - Topic-specific +;;;_ > outline-show-entry () +; outline-show-entry basically for isearch dynamic exposure, as is... +(defun outline-show-entry () + "Like `outline-show-current-entry', reveals entries nested in hidden topics. + +This is a way to give restricted peek at a concealed locality without the +expense of exposing its context, but can leave the outline with aberrant +exposure. outline-hide-current-entry-completely or outline-show-offshoot +should be used after the peek to rectify the exposure." (interactive) - (if (not workbuf) (setq workbuf (concat (buffer-name) " exposed"))) - (let ((buf (current-buffer))) - (if (not (get-buffer workbuf)) - (generate-new-buffer workbuf)) - (pop-to-buffer workbuf) - (erase-buffer) - (insert-buffer buf) - ;; (replace-regexp "\^M[^\^M\^J]*" "") - (while (re-search-forward "\^M[^\^M\^J]*" nil t) - (replace-match "" nil nil)) - (goto-char (point-min)) - ) - ) -;;;_ > outlinify-sticky () -(defun outlinify-sticky (&optional arg) - " Activate outline mode and establish file eval to set initial exposure. - - Invoke with a string argument to designate a string to prepend to - topic prefixs, or with a universal argument to be prompted for the - string to be used. Suitable defaults are provided for lisp, - emacs-lisp, c, c++, awk, sh, csh, and perl modes." - - (interactive "P") (outline-mode t) - (cond (arg - (if (stringp arg) - ;; Use arg as the header-prefix: - (outline-lead-with-comment-string arg) - ;; Otherwise, let function solicit string: - (setq arg (outline-lead-with-comment-string)))) - ((member major-mode '(emacs-lisp-mode lisp-mode)) - (setq arg (outline-lead-with-comment-string ";;;_"))) - ((member major-mode '(awk-mode csh-mode sh-mode perl-mode)) - ;; Bare '#' (ie, not '#_') so we don't break the magic number: - (setq arg (outline-lead-with-comment-string "#"))) - ((eq major-mode 'c++-mode) - (setq arg (outline-lead-with-comment-string "//_"))) - ((eq major-mode 'c-mode) - ;; User's will have to know to close off the comments: - (setq arg (outline-lead-with-comment-string "/*_")))) - (let* ((lead-prefix (format "%s%s" - (concat outline-header-prefix (if arg " " "")) - outline-primary-bullet)) - (lead-line (format "%s%s %s\n%s %s\n %s %s %s" - (if arg outline-header-prefix "") - outline-primary-bullet - "Local emacs vars." - "'(This topic sets initial outline exposure" - "of the file when loaded by emacs," - "Encapsulate it in comments if" - "file is a program" - "otherwise ignore it,"))) + (save-excursion + (outline-goto-prefix) + (outline-flag-region (if (bobp) (point) (1- (point))) + (or (outline-pre-next-preface) (point)) + ?\n))) +;;;_ > outline-show-children (&optional level strict) +(defun outline-show-children (&optional level strict) + + "If point is visible, show all direct subheadings of this heading. + +Otherwise, do outline-show-to-offshoot, and then show subheadings. + +Optional LEVEL specifies how many levels below the current level +should be shown, or all levels if t. Default is 1. + +Optional STRICT means don't resort to -show-to-offshoot, no matter +what. This is basically so -show-to-offshoot, which is called by +this function, can employ the pure offspring-revealing capabilities of +it. + +Returns point at end of subtree that was opened, if any. (May get a +point of non-opened subtree?)" + + (interactive "p") + (let (max-pos) + (if (and (not strict) + (outline-hidden-p)) + + (progn (outline-show-to-offshoot) ; Point's concealed, open to + ; expose it. + ;; Then recurse, but with "strict" set so we don't + ;; infinite regress: + (setq max-pos (outline-show-children level t))) + + (save-excursion + (save-restriction + (let* ((start-pt (point)) + (chart (outline-chart-subtree (or level 1))) + (to-reveal (outline-chart-to-reveal chart (or level 1)))) + (goto-char start-pt) + (if (and strict (= (preceding-char) ?\r)) + ;; Concealed root would already have been taken care of, + ;; unless strict was set. + (outline-flag-region (point) (outline-snug-back) ?\n)) + (while to-reveal + (goto-char (car to-reveal)) + (outline-flag-region (point) (outline-snug-back) ?\n) + (setq to-reveal (cdr to-reveal))))))))) +;;;_ x outline-show-current-children (&optional level strict) +(defun outline-show-current-children (&optional level strict) + "This command was misnamed, use `outline-show-children' instead. + +\(The \"current\" in the name is supposed to imply that it works on +the visible topic containing point, while it really works with respect +to the most immediate topic, concealed or not. I'll leave this old +name around for a bit, but i'll soon activate an annoying message to +warn people about the change, and then deprecate this alias." + + (interactive "p") + ;;(beep) + ;;(message (format "Use '%s' instead of '%s' (%s)." + ;; "outline-show-children" + ;; "outline-show-current-children" + ;; (buffer-name (current-buffer)))) + (outline-show-children level strict)) +;;;_ > outline-hide-point-reconcile () +(defun outline-hide-reconcile () + "Like `outline-hide-current-entry'; hides completely if within hidden region. + +Specifically intended for aberrant exposure states, like entries that were +exposed by outline-show-entry but are within otherwise concealed regions." + (interactive) + (save-excursion + (outline-goto-prefix) + (outline-flag-region (if (not (bobp)) (1- (point)) (point)) + (progn (outline-pre-next-preface) + (if (= ?\r (following-char)) + (point) + (1- (point)))) + ?\r))) +;;;_ > outline-show-to-offshoot () +(defun outline-show-to-offshoot () + "Like outline-show-entry, but reveals opens all concealed ancestors, as well. +As with outline-hide-current-entry-completely, useful for rectifying +aberrant exposure states produced by outline-show-entry." + + (interactive) + (save-excursion + (let ((orig-pt (point)) + (orig-pref (outline-goto-prefix)) + (last-at (point)) + bag-it) + (while (or bag-it (= (preceding-char) ?\r)) + (beginning-of-line) + (if (= last-at (setq last-at (point))) + ;; Oops, we're not making any progress! Show the current + ;; topic completely, and bag this try. + (progn (beginning-of-line) + (outline-show-current-subtree) + (goto-char orig-pt) + (setq bag-it t) + (beep) + (message "%s: %s" + "outline-show-to-offshoot: " + "Aberrant nesting encountered."))) + (outline-show-children) + (goto-char orig-pref)) + (goto-char orig-pt))) + (if (outline-hidden-p) + (outline-show-entry))) +;;;_ > outline-hide-current-entry () +(defun outline-hide-current-entry () + "Hide the body directly following this heading." + (interactive) + (outline-back-to-current-heading) + (save-excursion + (outline-flag-region (point) + (progn (outline-end-of-current-entry) (point)) + ?\^M))) +;;;_ > outline-show-current-entry (&optional arg) +(defun outline-show-current-entry (&optional arg) + + "Show body following current heading, or hide the entry if repeat count." + + (interactive "P") + (if arg + (outline-hide-current-entry) (save-excursion - ; Put a topic at the top, if - ; none there already: + (outline-flag-region (point) + (progn (outline-end-of-current-entry) (point)) + ?\n)))) +;;;_ > outline-hide-current-entry-completely () +; ... outline-hide-current-entry-completely also for isearch dynamic exposure: +(defun outline-hide-current-entry-completely () + "Like outline-hide-current-entry, but conceal topic completely. + +Specifically intended for aberrant exposure states, like entries that were +exposed by outline-show-entry but are within otherwise concealed regions." + (interactive) + (save-excursion + (outline-goto-prefix) + (outline-flag-region (if (not (bobp)) (1- (point)) (point)) + (progn (outline-pre-next-preface) + (if (= ?\r (following-char)) + (point) + (1- (point)))) + ?\r))) +;;;_ > outline-show-current-subtree (&optional arg) +(defun outline-show-current-subtree (&optional arg) + "Show everything within the current topic. With a repeat-count, +expose this topic and its' siblings." + (interactive "P") + (save-excursion + (if (<= (outline-current-depth) 0) + ;; Outside any topics - try to get to the first: + (if (not (outline-next-heading)) + (error "No topics.") + ;; got to first, outermost topic - set to expose it and siblings: + (message "Above outermost topic - exposing all.") + (outline-flag-region (point-min)(point-max) ?\n)) + (if (not arg) + (outline-flag-current-subtree ?\n) + (outline-beginning-of-level) + (outline-expose-topic '(* :)))))) +;;;_ > outline-hide-current-subtree (&optional just-close) +(defun outline-hide-current-subtree (&optional just-close) + "Close the current topic, or containing topic if this one is already closed. + +If this topic is closed and it's a top level topic, close this topic +and its' siblings. + +If optional arg JUST-CLOSE is non-nil, do not treat the parent or +siblings, even if the target topic is already closed." + + (interactive) + (let ((from (point)) + (orig-eol (progn (end-of-line) + (if (not (outline-goto-prefix)) + (error "No topics found.") + (end-of-line)(point))))) + (outline-flag-current-subtree ?\^M) + (goto-char from) + (if (and (= orig-eol (progn (goto-char orig-eol) + (end-of-line) + (point))) + (not just-close) + ;; Structure didn't change - try hiding current level: + (goto-char from) + (if (outline-up-current-level 1 t) + t + (goto-char 0) + (let ((msg + "Top-level topic already closed - closing siblings...")) + (message msg) + (outline-expose-topic '(0 :)) + (message (concat msg " Done."))) + nil) + (/= (outline-recent-depth) 0)) + (outline-hide-current-subtree)) + (goto-char from))) +;;;_ > outline-show-current-branches () +(defun outline-show-current-branches () + "Show all subheadings of this heading, but not their bodies." + (interactive) + (beginning-of-line) + (outline-show-children t)) +;;;_ > outline-hide-current-leaves () +(defun outline-hide-current-leaves () + "Hide the bodies of the current topic and all its' offspring." + (interactive) + (outline-back-to-current-heading) + (outline-hide-region-body (point) (progn (outline-end-of-current-subtree) + (point)))) + +;;;_ - Region and beyond +;;;_ > outline-show-all () +(defun outline-show-all () + "Show all of the text in the buffer." + (interactive) + (message "Exposing entire buffer...") + (outline-flag-region (point-min) (point-max) ?\n) + (message "Exposing entire buffer... Done.")) +;;;_ > outline-hide-bodies () +(defun outline-hide-bodies () + "Hide all of buffer except headings." + (interactive) + (outline-hide-region-body (point-min) (point-max))) +;;;_ > outline-hide-region-body (start end) +(defun outline-hide-region-body (start end) + "Hide all body lines in the region, but not headings." + (save-excursion + (save-restriction + (narrow-to-region start end) (goto-char (point-min)) - (if (not (looking-at outline-regexp)) - (insert-string - (if (not arg) outline-primary-bullet - (format "%s%s\n" outline-header-prefix outline-primary-bullet)))) - - ; File-vars stuff, at the bottom: + (while (not (eobp)) + (outline-flag-region (point) + (progn (outline-pre-next-preface) (point)) ?\^M) + (if (not (eobp)) + (forward-char + (if (looking-at "[\n\r][\n\r]") + 2 1))))))) + +;;;_ > outline-expose-topic (spec) +(defun outline-expose-topic (spec) + "Apply exposure specs to successive outline topic items. + +Use the more convenient frontend, `outline-new-exposure', if you don't +need evaluation of the arguments, or even better, the `outline-layout' +variable-keyed mode-activation/auto-exposure feature of allout outline +mode. See the respective documentation strings for more details. + +Cursor is left at start position. + +SPEC is either a number or a list. + +Successive specs on a list are applied to successive sibling topics. + +A simple spec \(either a number, one of a few symbols, or the null +list) dictates the exposure for the corresponding topic. + +Non-null lists recursively designate exposure specs for respective +subtopics of the current topic. + +The ':' repeat spec is used to specify exposure for any number of +successive siblings, up to the trailing ones for which there are +explicit specs following the ':'. + +Simple (numeric and null-list) specs are interpreted as follows: + + Numbers indicate the relative depth to open the corresponding topic. + - negative numbers force the topic to be closed before opening to the + absolute value of the number, so all siblings are open only to + that level. + - positive numbers open to the relative depth indicated by the + number, but do not force already opened subtopics to be closed. + - 0 means to close topic - hide all offspring. + : - 'repeat' + apply prior element to all siblings at current level, *up to* + those siblings that would be covered by specs following the ':' + on the list. Ie, apply to all topics at level but the last + ones. \(Only first of multiple colons at same level is + respected - subsequent ones are discarded.) + * - completely opens the topic, including bodies. + + - shows all the sub headers, but not the bodies + - - exposes the body of the corresponding topic. + +Examples: +\(outline-expose-topic '(-1 : 0)) + Close this and all following topics at current level, exposing + only their immediate children, but close down the last topic + at this current level completely. +\(outline-expose-topic '(-1 () : 1 0)) + Close current topic so only the immediate subtopics are shown; + show the children in the second to last topic, and completely + close the last one. +\(outline-expose-topic '(-2 : -1 *)) + Expose children and grandchildren of all topics at current + level except the last two; expose children of the second to + last and completely open the last one." + + (interactive "xExposure spec: ") + (if (not (listp spec)) + nil + (let ((depth (outline-depth)) + (max-pos 0) + prev-elem curr-elem + stay done + snug-back + ) + (while spec + (setq prev-elem curr-elem + curr-elem (car spec) + spec (cdr spec)) + (cond ; Do current element: + ((null curr-elem) nil) + ((symbolp curr-elem) + (cond ((eq curr-elem '*) (outline-show-current-subtree) + (if (> outline-recent-end-of-subtree max-pos) + (setq max-pos outline-recent-end-of-subtree))) + ((eq curr-elem '+) (outline-show-current-branches) + (if (> outline-recent-end-of-subtree max-pos) + (setq max-pos outline-recent-end-of-subtree))) + ((eq curr-elem '-) (outline-show-current-entry)) + ((eq curr-elem ':) + (setq stay t) + ;; Expand the 'repeat' spec to an explicit version, + ;; w.r.t. remaining siblings: + (let ((residue ; = # of sibs not covered by remaining spec + ;; Dang - could be nice to make use of the chart, sigh: + (- (length (outline-chart-siblings)) + (length spec)))) + (if (< 0 residue) + ;; Some residue - cover it with prev-elem: + (setq spec (append (make-list residue prev-elem) + spec))))))) + ((numberp curr-elem) + (if (and (>= 0 curr-elem) (outline-visible-p)) + (save-excursion (outline-hide-current-subtree t) + (if (> 0 curr-elem) + nil + (if (> outline-recent-end-of-subtree max-pos) + (setq max-pos + outline-recent-end-of-subtree))))) + (if (> (abs curr-elem) 0) + (progn (outline-show-children (abs curr-elem)) + (if (> outline-recent-end-of-subtree max-pos) + (setq max-pos outline-recent-end-of-subtree))))) + ((listp curr-elem) + (if (outline-descend-to-depth (1+ depth)) + (let ((got (outline-expose-topic curr-elem))) + (if (and got (> got max-pos)) (setq max-pos got)))))) + (cond (stay (setq stay nil)) + ((listp (car spec)) nil) + ((> max-pos (point)) + ;; Capitalize on max-pos state to get us nearer next sibling: + (progn (goto-char (min (point-max) max-pos)) + (outline-next-heading))) + ((outline-next-sibling depth)))) + max-pos))) +;;;_ > outline-old-expose-topic (spec &rest followers) +(defun outline-old-expose-topic (spec &rest followers) + + "Deprecated. Use outline-expose-topic \(with different schema +format\) instead. + +Dictate wholesale exposure scheme for current topic, according to SPEC. + +SPEC is either a number or a list. Optional successive args +dictate exposure for subsequent siblings of current topic. + +A simple spec (either a number, a special symbol, or the null list) +dictates the overall exposure for a topic. Non null lists are +composite specs whose first element dictates the overall exposure for +a topic, with the subsequent elements in the list interpreted as specs +that dictate the exposure for the successive offspring of the topic. + +Simple (numeric and null-list) specs are interpreted as follows: + + - Numbers indicate the relative depth to open the corresponding topic: + - negative numbers force the topic to be close before opening to the + absolute value of the number. + - positive numbers just open to the relative depth indicated by the number. + - 0 just closes + - '*' completely opens the topic, including bodies. + - '+' shows all the sub headers, but not the bodies + - '-' exposes the body and immediate offspring of the corresponding topic. + +If the spec is a list, the first element must be a number, which +dictates the exposure depth of the topic as a whole. Subsequent +elements of the list are nested SPECs, dictating the specific exposure +for the corresponding offspring of the topic. + +Optional FOLLOWER arguments dictate exposure for succeeding siblings." + + (interactive "xExposure spec: ") + (let ((depth (outline-current-depth)) + done + max-pos) + (cond ((null spec) nil) + ((symbolp spec) + (if (eq spec '*) (outline-show-current-subtree)) + (if (eq spec '+) (outline-show-current-branches)) + (if (eq spec '-) (outline-show-current-entry))) + ((numberp spec) + (if (>= 0 spec) + (save-excursion (outline-hide-current-subtree t) + (end-of-line) + (if (or (not max-pos) + (> (point) max-pos)) + (setq max-pos (point))) + (if (> 0 spec) + (setq spec (* -1 spec))))) + (if (> spec 0) + (outline-show-children spec))) + ((listp spec) + ;(let ((got (outline-old-expose-topic (car spec)))) + ; (if (and got (or (not max-pos) (> got max-pos))) + ; (setq max-pos got))) + (let ((new-depth (+ (outline-current-depth) 1)) + got) + (setq max-pos (outline-old-expose-topic (car spec))) + (setq spec (cdr spec)) + (if (and spec + (outline-descend-to-depth new-depth) + (not (outline-hidden-p))) + (progn (setq got (apply 'outline-old-expose-topic spec)) + (if (and got (or (not max-pos) (> got max-pos))) + (setq max-pos got))))))) + (while (and followers + (progn (if (and max-pos (< (point) max-pos)) + (progn (goto-char max-pos) + (setq max-pos nil))) + (end-of-line) + (outline-next-sibling depth))) + (outline-old-expose-topic (car followers)) + (setq followers (cdr followers))) + max-pos)) +;;;_ > outline-new-exposure '() +(defmacro outline-new-exposure (&rest spec) + "Literal frontend for `outline-expose-topic', doesn't evaluate arguments. +Some arguments that would need to be quoted in outline-expose-topic +need not be quoted in outline-new-exposure. + +Cursor is left at start position. + +Use this instead of obsolete 'outline-exposure'. + +Examples: +\(outline-exposure (-1 () () () 1) 0) + Close current topic at current level so only the immediate + subtopics are shown, except also show the children of the + third subtopic; and close the next topic at the current level. +\(outline-exposure : -1 0) + Close all topics at current level to expose only their + immediate children, except for the last topic at the current + level, in which even its' immediate children are hidden. +\(outline-exposure -2 : -1 *) + Expose children and grandchildren of first topic at current + level, and expose children of subsequent topics at current + level *except* for the last, which should be opened completely." + (list 'save-excursion + '(if (not (or (outline-goto-prefix) + (outline-next-heading))) + (error "outline-new-exposure: Can't find any outline topics.")) + (list 'outline-expose-topic (list 'quote spec)))) +;;;_ > outline-exposure '() +(defmacro outline-exposure (&rest spec) + "Being deprecated - use more recent 'outline-new-exposure' instead. + +Literal frontend for `outline-old-expose-topic', doesn't evaluate arguments +and retains start position." + (list 'save-excursion + '(if (not (or (outline-goto-prefix) + (outline-next-heading))) + (error "Can't find any outline topics.")) + (cons 'outline-old-expose-topic + (mapcar '(lambda (x) (list 'quote x)) spec)))) + +;;;_ #7 ISearch with Dynamic Exposure +;;;_ = outline-search-reconceal +(defvar outline-search-reconceal nil + "Track whether current search match was concealed outside of search. + +The value is the location of the match, if it was concealed, regular +if the entire topic was concealed, in a list if the entry was concealed.") +;;;_ = outline-search-quitting +(defconst outline-search-quitting nil + "Distinguishes isearch conclusion and cancellation. + +Used by isearch-terminate/outline-provisions and +isearch-done/outline-provisions") + + +;;;_ > outline-enwrap-isearch () +(defun outline-enwrap-isearch () + "Impose outline-mode isearch-mode wrappers for dynamic exposure in isearch. + +Isearch progressively exposes and reconceals hidden topics when +working in outline mode, but works normally elsewhere. + +The function checks to ensure that the rebindings are done only once." + + ; Should isearch-mode be employed, + (if (or (not outline-enwrap-isearch-mode) + ; or are preparations already done? + (fboundp 'real-isearch-terminate)) + + ;; ... no - skip this all: + nil + + ;; ... yes: + + ; Ensure load of isearch-mode: + (if (or (and (fboundp 'isearch-mode) + (fboundp 'isearch-quote-char)) + (condition-case error + (load-library outline-enwrap-isearch-mode) + (file-error (message "Skipping isearch-mode provisions - %s '%s'" + (car (cdr error)) + (car (cdr (cdr error)))) + (sit-for 1) + ;; Inhibit subsequent tries and return nil: + (setq outline-enwrap-isearch-mode nil)))) + ;; Isearch-mode loaded, encapsulate specific entry points for + ;; outline dynamic-exposure business: + (progn + + ;; stash crucial isearch-mode funcs under known, private + ;; names, then register wrapper functions under the old + ;; names, in their stead: 'isearch-quit' is pre isearch v 1.2. + (fset 'real-isearch-terminate + ; 'isearch-quit is pre v 1.2: + (or (if (fboundp 'isearch-quit) + (symbol-function 'isearch-quit)) + (if (fboundp 'isearch-abort) + ; 'isearch-abort' is v 1.2 and on: + (symbol-function 'isearch-abort)))) + (fset 'isearch-quit 'isearch-terminate/outline-provisions) + (fset 'isearch-abort 'isearch-terminate/outline-provisions) + (fset 'real-isearch-done (symbol-function 'isearch-done)) + (fset 'isearch-done 'isearch-done/outline-provisions) + (fset 'real-isearch-update (symbol-function 'isearch-update)) + (fset 'isearch-update 'isearch-update/outline-provisions) + (make-variable-buffer-local 'outline-search-reconceal))))) +;;;_ > outline-isearch-arrival-business () +(defun outline-isearch-arrival-business () + "Do outline business like exposing current point, if necessary. + +Registers reconcealment requirements in outline-search-reconceal +accordingly. + +Set outline-search-reconceal to nil if current point is not +concealed, to value of point if entire topic is concealed, and a +list containing point if only the topic body is concealed. + +This will be used to determine whether outline-hide-current-entry +or outline-hide-current-entry-completely will be necessary to +restore the prior concealment state." + + (if (outline-mode-p) + (setq outline-search-reconceal + (if (outline-hidden-p) + (save-excursion + (if (re-search-backward outline-line-boundary-regexp nil 1) + ;; Nil value means we got to b-o-b - wouldn't need + ;; to advance. + (forward-char 1)) + ; We'll return point or list + ; containing point, depending + ; on concealment state of + ; topic prefix. + (prog1 (if (outline-hidden-p) (point) (list (point))) + ; And reveal the current + ; search target: + (outline-show-entry))))))) +;;;_ > outline-isearch-advancing-business () +(defun outline-isearch-advancing-business () + "Do outline business like deexposing current point, if necessary. + +Works according to reconceal state registration." + (if (and (outline-mode-p) outline-search-reconceal) + (save-excursion + (if (listp outline-search-reconceal) + ;; Leave the topic visible: + (progn (goto-char (car outline-search-reconceal)) + (outline-hide-current-entry)) + ;; Rehide the entire topic: + (goto-char outline-search-reconceal) + (outline-hide-current-entry-completely))))) +;;;_ > isearch-terminate/outline-provisions () +(defun isearch-terminate/outline-provisions () + (interactive) + (if (and (outline-mode-p) outline-enwrap-isearch-mode) + (outline-isearch-advancing-business)) + (let ((outline-search-quitting t) + (outline-search-reconceal nil)) + (real-isearch-terminate))) +;;;_ > isearch-done/outline-provisions () +(defun isearch-done/outline-provisions (&optional nopush) + (interactive) + (if (and (outline-mode-p) outline-enwrap-isearch-mode) + (progn (if (and outline-search-reconceal + (not (listp outline-search-reconceal))) + ;; The topic was concealed - reveal it, its siblings, + ;; and any ancestors that are still concealed: + (save-excursion + (message "(exposing destination)")(sit-for 0) + (outline-goto-prefix) + ; There may be a closed blank + ; line between prior and + ; current topic that would be + ; missed - provide for it: + (if (not (bobp)) + (progn (forward-char -1) ; newline + (if (eq ?\r (preceding-char)) + (outline-flag-region (1- (point)) + (point) + ?\n)) + (forward-char 1))) + ; Goto parent + (outline-ascend-to-depth (1- (outline-recent-depth))) + (outline-show-children))) + (if (and (boundp 'outline-search-quitting) + outline-search-quitting) + nil + ; We're concluding abort: + (outline-isearch-arrival-business) + (outline-show-children)))) + (if nopush + ;; isearch-done in newer version of isearch mode takes arg: + (real-isearch-done nopush) + (real-isearch-done))) +;;;_ > isearch-update/outline-provisions () +(defun isearch-update/outline-provisions () + "Wrapper dynamically adjusts isearch target exposure. + +Appropriately exposes and reconceals hidden outline portions, as +necessary, in the course of searching." + (if (not (and (outline-mode-p) outline-enwrap-isearch-mode)) + ;; Just do the plain business: + (real-isearch-update) + + ;; Ah - provide for outline conditions: + (outline-isearch-advancing-business) + (real-isearch-update) + (cond (isearch-success (outline-isearch-arrival-business)) + ((not isearch-success) (outline-isearch-advancing-business))))) + +;;;_ #8 Copying and printing + +;;;_ - Copy exposed +;;;_ > outline-insert-listified (depth prefix bullet text) +(defun outline-insert-listified (depth prefix bullet text) + "Insert contents of listified outline portion in current buffer." + (insert-string (concat (if (> depth 1) prefix "") + (make-string (1- depth) ?\ ) + bullet)) + (while text + (insert-string (car text)) + (if (setq text (cdr text)) + (insert-string "\n"))) + (insert-string "\n")) +;;;_ > outline-copy-exposed (arg &optional tobuf) +(defun outline-copy-exposed (arg &optional tobuf) + "Duplicate exposed portions of current topic to another buffer. + +Other buffer has current buffers' name with \" exposed\" appended to it. + +With repeat count, copy the exposed portions of entire buffer." + + (interactive "P") + (if (not tobuf) + (setq tobuf (get-buffer-create (concat "*" (buffer-name) " exposed*")))) + (let* ((start-pt (point)) + (beg (if arg (point-min) (outline-back-to-current-heading))) + (end (if arg (point-max) (outline-end-of-current-subtree))) + (buf (current-buffer))) + (save-excursion (set-buffer tobuf)(erase-buffer)) + (outline-process-exposed 'outline-insert-listified + beg + end + (current-buffer) + tobuf) + (goto-char (point-min)) + (pop-to-buffer buf) + (goto-char start-pt))) + +;;;_ - LaTeX formatting +;;;_ > outline-latex-verb-quote (str &optional flow) +(defun outline-latex-verb-quote (str &optional flow) + "Return copy of STRING for literal reproduction across latex processing. +Expresses the original characters \(including carriage returns) of the +string across latex processing." + (mapconcat '(lambda (char) + ;;;mess: (cond ((memq char '(?"" ?$ ?% ?# ?& ?- ?" ?` ?^ ?- ?*));;;")))) + (cond ((memq char '(?\\ ?$ ?% ?# ?& ?{ ?} ?_ ?^ ?- ?*)) + (concat "\\char" (number-to-string char) "{}")) + ((= char ?\n) "\\\\") + (t (char-to-string char)))) + str + "")) +;;;_ > outline-latex-verbatim-quote-curr-line () +(defun outline-latex-verbatim-quote-curr-line () + "Express line for exact \(literal\) representation across latex processing. + +Adjust line contents so it is unaltered \(from the original line) +across latex processing, within the context of a 'verbatim' +environment. Leaves point at the end of the line." + (beginning-of-line) + (let ((beg (point)) + (end (progn (end-of-line)(point)))) + (goto-char beg) + (while (re-search-forward "\\\\" + ;;"\\\\\\|\\{\\|\\}\\|\\_\\|\\$\\|\\\"\\|\\&\\|\\^\\|\\-\\|\\*\\|#" + end ; bounded by end-of-line + 1) ; no matches, move to end & return nil + (goto-char (match-beginning 0)) + (insert-string "\\") + (setq end (1+ end)) + (goto-char (1+ (match-end 0)))))) +;;;_ > outline-insert-latex-header (buf) +(defun outline-insert-latex-header (buf) + "Insert initial latex commands at point in BUFFER." + ;; Much of this is being derived from the stuff in appendix of E in + ;; the TeXBook, pg 421. + (set-buffer buf) + (let ((doc-style (format "\n\\documentstyle{%s}\n" + "report")) + (page-numbering (if outline-number-pages + "\\pagestyle{empty}\n" + "")) + (linesdef (concat "\\def\\beginlines{" + "\\par\\begingroup\\nobreak\\medskip" + "\\parindent=0pt\n" + " \\kern1pt\\nobreak \\obeylines \\obeyspaces " + "\\everypar{\\strut}}\n" + "\\def\\endlines{" + "\\kern1pt\\endgroup\\medbreak\\noindent}\n")) + (titlecmd (format "\\newcommand{\\titlecmd}[1]{{%s #1}}\n" + outline-title-style)) + (labelcmd (format "\\newcommand{\\labelcmd}[1]{{%s #1}}\n" + outline-label-style)) + (headlinecmd (format "\\newcommand{\\headlinecmd}[1]{{%s #1}}\n" + outline-head-line-style)) + (bodylinecmd (format "\\newcommand{\\bodylinecmd}[1]{{%s #1}}\n" + outline-body-line-style)) + (setlength (format "%s%s%s%s" + "\\newlength{\\stepsize}\n" + "\\setlength{\\stepsize}{" + outline-indent + "}\n")) + (oneheadline (format "%s%s%s%s%s%s%s" + "\\newcommand{\\OneHeadLine}[3]{%\n" + "\\noindent%\n" + "\\hspace*{#2\\stepsize}%\n" + "\\labelcmd{#1}\\hspace*{.2cm}" + "\\headlinecmd{#3}\\\\[" + outline-line-skip + "]\n}\n")) + (onebodyline (format "%s%s%s%s%s%s" + "\\newcommand{\\OneBodyLine}[2]{%\n" + "\\noindent%\n" + "\\hspace*{#1\\stepsize}%\n" + "\\bodylinecmd{#2}\\\\[" + outline-line-skip + "]\n}\n")) + (begindoc "\\begin{document}\n\\begin{center}\n") + (title (format "%s%s%s%s" + "\\titlecmd{" + (outline-latex-verb-quote (if outline-title + (condition-case err + (eval outline-title) + (error "")) + "Unnamed Outline")) + "}\n" + "\\end{center}\n\n")) + (hsize "\\hsize = 7.5 true in\n") + (hoffset "\\hoffset = -1.5 true in\n") + (vspace "\\vspace{.1cm}\n\n")) + (insert (concat doc-style + page-numbering + titlecmd + labelcmd + headlinecmd + bodylinecmd + setlength + oneheadline + onebodyline + begindoc + title + hsize + hoffset + vspace) + ))) +;;;_ > outline-insert-latex-trailer (buf) +(defun outline-insert-latex-trailer (buf) + "Insert concluding latex commands at point in BUFFER." + (set-buffer buf) + (insert "\n\\end{document}\n")) +;;;_ > outline-latexify-one-item (depth prefix bullet text) +(defun outline-latexify-one-item (depth prefix bullet text) + "Insert LaTeX commands for formatting one outline item. + +Args are the topics' numeric DEPTH, the header PREFIX lead string, the +BULLET string, and a list of TEXT strings for the body." + (let* ((head-line (if text (car text))) + (body-lines (cdr text)) + (curr-line) + body-content bop) + ; Do the head line: + (insert-string (concat "\\OneHeadLine{\\verb\1 " + (outline-latex-verb-quote bullet) + "\1}{" + depth + "}{\\verb\1 " + (if head-line + (outline-latex-verb-quote head-line) + "") + "\1}\n")) + (if (not body-lines) + nil + ;;(insert-string "\\beginlines\n") + (insert-string "\\begin{verbatim}\n") + (while body-lines + (setq curr-line (car body-lines)) + (if (and (not body-content) + (not (string-match "^\\s-*$" curr-line))) + (setq body-content t)) + ; Mangle any occurrences of + ; "\end{verbatim}" in text, + ; it's special: + (if (and body-content + (setq bop (string-match "\\end{verbatim}" curr-line))) + (setq curr-line (concat (substring curr-line 0 bop) + ">" + (substring curr-line bop)))) + ;;(insert-string "|" (car body-lines) "|") + (insert-string curr-line) + (outline-latex-verbatim-quote-curr-line) + (insert-string "\n") + (setq body-lines (cdr body-lines))) + (if body-content + (setq body-content nil) + (forward-char -1) + (insert-string "\\ ") + (forward-char 1)) + ;;(insert-string "\\endlines\n") + (insert-string "\\end{verbatim}\n") + ))) +;;;_ > outline-latexify-exposed (arg &optional tobuf) +(defun outline-latexify-exposed (arg &optional tobuf) + "Format current topic's exposed portions to TOBUF for latex processing. +TOBUF defaults to a buffer named the same as the current buffer, but +with \"*\" prepended and \" latex-formed*\" appended. + +With repeat count, copy the exposed portions of entire buffer." + + (interactive "P") + (if (not tobuf) + (setq tobuf + (get-buffer-create (concat "*" (buffer-name) " latexified*")))) + (let* ((start-pt (point)) + (beg (if arg (point-min) (outline-back-to-current-heading))) + (end (if arg (point-max) (outline-end-of-current-subtree))) + (buf (current-buffer))) + (set-buffer tobuf) + (erase-buffer) + (outline-insert-latex-header tobuf) + (goto-char (point-max)) + (outline-process-exposed 'outline-latexify-one-item + beg + end + buf + tobuf) + (goto-char (point-max)) + (outline-insert-latex-trailer tobuf) + (goto-char (point-min)) + (pop-to-buffer buf) + (goto-char start-pt))) + +;;;_ #9 miscellaneous +;;;_ > outline-mark-topic () +(defun outline-mark-topic () + "Put the region around topic currently containing point." + (interactive) + (beginning-of-line) + (outline-goto-prefix) + (push-mark (point)) + (outline-end-of-current-subtree) + (exchange-point-and-mark)) +;;;_ > outlineify-sticky () +;; outlinify-sticky is correct spelling; provide this alias for sticklers: +(defalias 'outlinify-sticky 'outlineify-sticky) +(defun outlineify-sticky (&optional arg) + "Activate outline mode and establish file var so it is started subseqently. + +See doc-string for `outline-layout' and `outline-init' for details on +setup for auto-startup." + + (interactive "P") + + (outline-mode t) + + (save-excursion + (goto-char (point-min)) + (if (looking-at outline-regexp) + t + (outline-open-topic 2) + (insert-string (concat "Dummy outline topic header - see" + "`outline-mode' docstring for info.")) + (next-line 1) (goto-char (point-max)) - ; Insert preamble: - (insert-string (format "\n\n%s\n%s %s %s\n%s %s " - lead-line - lead-prefix - "local" - "variables:" - lead-prefix - "eval:")) - ; Insert outline-mode activation: - (insert-string - (format "%s\n\t\t%s\n\t\t\t%s\n" - "(condition-case err" - "(save-excursion" - "(outline-mode t)")) - ; Conditionally insert prefix - ; leader customization: - (if arg (insert-string (format "\t\t\t(%s \"%s\")\n" - "outline-lead-with-comment-string" - arg))) - ; Insert announcement and - ; exposure control: - (insert-string - (format "\t\t\t%s %s\n\t\t\t%s %s\n\t\t%s %s" - "(message \"Adjusting '%s' visibility\"" - "(buffer-name))" - "(goto-char 0)" - "(outline-exposure -1 0))" - "(error (message " - "\"Failed file var 'allout' provisions\")))")) - ; Insert postamble: - (insert-string (format "\n%s End: )\n" - lead-prefix))))) -;;;_ > solicit-char-in-string (prompt string &optional do-defaulting) + (next-line 1) + (outline-open-topic 0) + (insert-string "Local emacs vars.\n") + (outline-open-topic 1) + (insert-string "(`outline-layout' is for allout.el outline-mode)\n") + (outline-open-topic 0) + (insert-string "Local variables:\n") + (outline-open-topic 0) + (insert-string (format "outline-layout: %s\n" + (or outline-layout + '(1 : 0)))) + (outline-open-topic 0) + (insert-string "End:\n")))) +;;;_ > solicit-char-in-string (prompt string &optional do-defaulting) (defun solicit-char-in-string (prompt string &optional do-defaulting) - " Solicit (with first arg PROMPT) choice of a character from string STRING. + "Solicit (with first arg PROMPT) choice of a character from string STRING. - Optional arg DO-DEFAULTING indicates to accept empty input (CR)." +Optional arg DO-DEFAULTING indicates to accept empty input (CR)." (let ((new-prompt prompt) got) @@ -2569,9 +4244,9 @@ parameterized communication between the two, if suitable.") ;; treatment for '?' character. (Might oughta change minibuffer ;; keymap instead, oh well.) (setq got - (char-to-string (let ((cursor-in-echo-area t)) (read-char)))) + (char-to-string (let ((cursor-in-echo-area nil)) (read-char)))) - (if (null (string-match got string)) + (if (null (string-match (regexp-quote got) string)) (if (and do-defaulting (string= got "\^M")) ;; We're defaulting, return null string to indicate that: (setq got "") @@ -2589,28 +4264,78 @@ parameterized communication between the two, if suitable.") ;; got something out of loop - return it: got) ) -;;;_ > string-sans-char (string char) -(defun string-sans-char (string char) - " Return a copy of STRING that lacks all instances of CHAR." - (cond ((string= string "") "") - ((= (aref string 0) char) (string-sans-char (substring string 1) char)) - ((concat (substring string 0 1) - (string-sans-char (substring string 1) char))))) +;;;_ > regexp-sans-escapes (string) +(defun regexp-sans-escapes (regexp &optional successive-backslashes) + "Return a copy of REGEXP with all character escapes stripped out. + +Representations of actual backslashes - '\\\\\\\\' - are left as a +single backslash. + +Optional arg SUCCESSIVE-BACKSLASHES is used internally for recursion." + + (if (string= regexp "") + "" + ;; Set successive-backslashes to number if current char is + ;; backslash, or else to nil: + (setq successive-backslashes + (if (= (aref regexp 0) ?\\) + (if successive-backslashes (1+ successive-backslashes) 1) + nil)) + (if (or (not successive-backslashes) (= 2 successive-backslashes)) + ;; Include first char: + (concat (substring regexp 0 1) + (regexp-sans-escapes (substring regexp 1))) + ;; Exclude first char, but maintain count: + (regexp-sans-escapes (substring regexp 1) successive-backslashes)))) +;;;_ - add-hook definition for divergent emacsen +;;;_ > add-hook (hook function &optional append) +(if (not (fboundp 'add-hook)) + (defun add-hook (hook function &optional append) + "Add to the value of HOOK the function FUNCTION unless already present. +\(It becomes the first hook on the list unless optional APPEND is non-nil, in +which case it becomes the last). HOOK should be a symbol, and FUNCTION may be +any valid function. HOOK's value should be a list of functions, not a single +function. If HOOK is void, it is first set to nil." + (or (boundp hook) (set hook nil)) + (or (if (consp function) + ;; Clever way to tell whether a given lambda-expression + ;; is equal to anything in the hook. + (let ((tail (assoc (cdr function) (symbol-value hook)))) + (equal function tail)) + (memq function (symbol-value hook))) + (set hook + (if append + (nconc (symbol-value hook) (list function)) + (cons function (symbol-value hook))))))) + +;;;_ #10 Under development +;;;_ > outline-bullet-isearch (&optional bullet) +(defun outline-bullet-isearch (&optional bullet) + "Isearch \(regexp\) for topic with bullet BULLET." + (interactive) + (if (not bullet) + (setq bullet (solicit-char-in-string + "ISearch for topic with bullet: " + (regexp-sans-escapes outline-bullets-string)))) + + (let ((isearch-regexp t) + (isearch-string (concat "^" + outline-header-prefix + "[ \t]*" + bullet))) + (isearch-repeat 'forward) + (isearch-mode t))) +;;;_ ? Re hooking up with isearch - use isearch-op-fun rather than +;;; wrapping the isearch functions. ;;;_* Local emacs vars. -'( -Local variables: -eval: (save-excursion - (if (not (condition-case err (outline-mode t) - (wrong-number-of-arguments nil))) - (progn - (message - "Allout outline-mode not loaded, not adjusting buffer exposure") - (sit-for 1)) - (message "Adjusting '%s' visibility" (buffer-name)) - (outline-lead-with-comment-string ";;;_") - (goto-char 0) - (outline-exposure (-1 () () () 1) 0))) -End: -) - +;;; The following `outline-layout' local variable setting: +;;; - closes all topics from the first topic to just before the third-to-last, +;;; - shows the children of the third to last (config vars) +;;; - and the second to last (code section), +;;; - and closes the last topic (this local-variables section). +;;;Local variables: +;;;outline-layout: (0 : -1 -1 0) +;;;End: + +;; allout.el ends here