-;;;_* 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 <klm@nist.gov>
+;; Maintainer: Ken Manheimer <klm@nist.gov>
+;; 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 <klm@nist.gov>
-;;;_ - Maintainer: Ken Manheimer <klm@nist.gov>
-;;;_ - 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))
(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:
'outline-distinctive-bullets-string))
cur-string
cur-len
+ cur-char
cur-char-string
index
new-string)
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
(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)
(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<SP> 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<CR> 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<SP> 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<CR> 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.
+
+\\<outline-mode-map>
+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))
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
(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
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
;; 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.
((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 ;;;
((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 "^\$")
outline-numbered-bullet))))
(point)))
dbl-space
- doing-beginning
- )
+ doing-beginning)
(if (not opening-on-blank)
; Positioning and vertical
(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)
(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.
(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
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)
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))
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)))
(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))
(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
;; 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
)
)
)
-;;;_ > 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 buffer>"))
+ "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)
;; 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 "")
;; 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