-;;;_* allout.el - Extensive outline mode for use alone and with other modes.
+;;; allout.el --- extensive outline mode for use alone and with other modes
-;;;_* Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1993, 1994, 2001 Free Software Foundation, Inc.
-;; Author: Ken Manheimer <klm@nist.gov>
-;; Maintainer: Ken Manheimer <klm@nist.gov>
+;; Author: Ken Manheimer <klm@python.org>
+;; Maintainer: Ken Manheimer <klm@python.org>
;; Created: Dec 1991 - first release to usenet
-;; Version: $Id: allout.el,v 4.1 1994/05/05 23:52:43 klm Exp klm $||
-;; Keywords: outline mode
+;; Version: $Id: allout.el,v 1.33 2002/07/03 13:19:13 lektu Exp $||
+;; Keywords: outlines mode wp languages
;; This file is part of GNU Emacs.
;; 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.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
-;;;_* Commentary:
+;;; 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.)
+;; and manipulation beyond standard emacs outline mode. It provides
+;; for structured editing of outlines, as well as navigation and
+;; exposure. It also provides for syntax-sensitive text like
+;; programming languages. (For an example, see the allout code
+;; itself, which is organized in ;; an outline framework.)
;;
-;; 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.
+;; In addition to outline navigation and exposure, allout includes:
+;;
+;; - topic-oriented repositioning, cut, and paste
+;; - integral outline exposure-layout
+;; - incremental search with dynamic exposure and reconcealment of hidden text
+;; - automatic topic-number maintenance
+;; - "Hot-spot" operation, for single-keystroke maneuvering and
+;; exposure control. (See the `outline-mode' docstring.)
+;;
+;; and many other features.
+;;
+;; The outline menubar additions provide quick reference to many of
+;; the features, and see the docstring of the variable `outline-init'
+;; for instructions on priming your emacs session for automatic
+;; activation of `outline-mode'.
;;
;; 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
+;; 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.
+;; Note - the lines beginning with `;;;_' are outline topic headers.
+;; Just `ESC-x eval-current-buffer' to give it a whirl.
-;;Ken Manheimer 301 975-3539
-;;ken.manheimer@nist.gov FAX: 301 963-9137
-;;
-;;Computer Systems and Communications Division
-;;
-;; Nat'l Institute of Standards and Technology
-;; Technology A151
-;; Gaithersburg, MD 20899
+;; Ken Manheimer klm@python.org
+
+;;; Code:
;;;_* Provide
(provide 'outline)
(provide 'allout)
;;;_* USER CUSTOMIZATION VARIABLES:
+(defgroup allout nil
+ "Extensive outline mode for use alone and with other modes."
+ :prefix "outline-"
+ :group 'outlines)
;;;_ + Layout, Mode, and Topic Header Configuration
;;;_ = outline-auto-activation
-(defvar outline-auto-activation nil
+(defcustom outline-auto-activation nil
"*Regulates auto-activation modality of allout outlines - see `outline-init'.
Setq-default by `outline-init' to regulate whether or not allout
With value `ask', auto-mode-activation is enabled, and endorsement for
performing auto-layout is asked of the user each time.
-With value `activate', only auto-mode-activation is enabled, auto-
-layout is not.
+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.")
+this variable."
+ :type '(choice (const :tag "On" t)
+ (const :tag "Ask about layout" "ask")
+ (const :tag "Mode only" "activate")
+ (const :tag "Off" nil))
+ :group 'allout)
;;;_ = outline-layout
(defvar outline-layout nil
"*Layout specification and provisional mode trigger for allout outlines.
Buffer-specific.
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.
+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
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:
+lines at the bottom of an Emacs Lisp file:
;;;Local variables:
-;;;outline-layout: \(0 : -1 -1 0\)
+;;;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
+`\(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.")
+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-show-bodies
+(defcustom outline-show-bodies nil
+ "*If non-nil, show entire body when exposing a topic, rather than
+just the header."
+ :type 'boolean
+ :group 'allout)
+(make-variable-buffer-local 'outline-show-bodies)
;;;_ = outline-header-prefix
-(defvar outline-header-prefix "."
+(defcustom 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.")
+outlines start at level 2 to avoid this discrepancy."
+ :type 'string
+ :group 'allout)
(make-variable-buffer-local 'outline-header-prefix)
;;;_ = outline-primary-bullet
-(defvar outline-primary-bullet "*"
+(defcustom 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
+The value of an asterisk (`*') provides for backwards compatibility
with the original emacs outline mode. See outline-plain-bullets-string
and outline-distinctive-bullets-string for the range of available
-bullets.")
+bullets."
+ :type 'string
+ :group 'allout)
(make-variable-buffer-local 'outline-primary-bullet)
;;;_ = outline-plain-bullets-string
-(defvar outline-plain-bullets-string (concat outline-primary-bullet
- "+-:.;,")
+(defcustom outline-plain-bullets-string ".:,;"
"*The bullets normally used in outline topic prefixes.
-See 'outline-distinctive-bullets-string' for the other kind of
+See `outline-distinctive-bullets-string' for the other kind of
bullets.
-DO NOT include the close-square-bracket, ']', as a bullet.
+DO NOT include the close-square-bracket, `]', as a bullet.
Outline mode has to be reactivated in order for changes to the value
-of this var to take effect.")
+of this var to take effect."
+ :type 'string
+ :group 'allout)
(make-variable-buffer-local 'outline-plain-bullets-string)
;;;_ = outline-distinctive-bullets-string
-(defvar outline-distinctive-bullets-string "=>([{}&!?#%\"X@$~\\"
+(defcustom outline-distinctive-bullets-string "*+-=>([{}&!?#%\"X@$~_\\"
"*Persistent outline header bullets used to distinguish special topics.
-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.
-
-You must run 'set-outline-regexp' in order for changes
-to the value of this var to effect outline-mode operation.
-
-DO NOT include the close-square-bracket, ']', on either of the bullet
-strings.")
+These bullets are used to distinguish topics from the run-of-the-mill
+ones. They are not used in the standard topic headers created by
+the topic-opening, shifting, and rebulleting \(eg, on topic shift,
+topic paste, blanket rebulleting) routines, but are offered among the
+choices for rebulleting. They are not altered by the above automatic
+rebulleting, so they can be used to characterize topics, eg:
+
+ `?' question topics
+ `\(' parenthetic comment \(with a matching close paren inside)
+ `[' meta-note \(with a matching close ] inside)
+ `\"' a quote
+ `=' value settings
+ `~' \"more or less\"
+
+... just for example. (`#' typically has a special meaning to the
+software, according to the value of `outline-numbered-bullet'.)
+
+See `outline-plain-bullets-string' for the selection of
+alternating bullets.
+
+You must run `set-outline-regexp' in order for outline mode to
+reconcile to changes of this value.
+
+DO NOT include the close-square-bracket, `]', on either of the bullet
+strings."
+ :type 'string
+ :group 'allout)
(make-variable-buffer-local 'outline-distinctive-bullets-string)
;;;_ = outline-use-mode-specific-leader
-(defvar outline-use-mode-specific-leader t
+(defcustom outline-use-mode-specific-leader t
"*When non-nil, use mode-specific topic-header prefixes.
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.
+so topic headers look like comments in the programming language.
String values are used as they stand.
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.\)
+\(See note about use of comment-start strings, below.)
Set to the symbol for either of `outline-mode-leaders' or
`comment-start' to use only one of them, respectively.
-Value `nil' means to always use the default \(`.'\).
+Value `nil' means to always use the default \(`.').
comment-start strings that do not end in spaces are tripled, and an
-'_' underscore is tacked on the end, to distinguish them from regular
+`_' 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
+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.\]")
+incorrect.]"
+ :type '(choice (const t) (const nil) string
+ (const outline-mode-leaders)
+ (const comment-start))
+ :group 'allout)
;;;_ = outline-mode-leaders
(defvar outline-mode-leaders '()
"Specific outline-prefix leading strings per major modes.
-Entries will be used in the stead (or lieu) of mode-specific
+Entries will be used instead or in lieu of mode-specific
comment-start strings. See also `outline-use-mode-specific-leader'.
If you're constructing a string that will comment-out outline
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.
+(defcustom 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.")
+are always respected by the topic maneuvering functions."
+ :type 'boolean
+ :group 'allout)
(make-variable-buffer-local 'outline-old-style-prefixes)
;;;_ = outline-stylish-prefixes - alternating bullets
-(defvar outline-stylish-prefixes t
+(defcustom 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.
+Otherwise, only asterisks (`*') and distinctive bullets are used.
This is how an outline can look (but sans indentation) with stylish
prefixes:
this variable setting.
The setting of this var is not relevant when outline-old-style-prefixes
-is non-nil.")
+is non-nil."
+ :type 'boolean
+ :group 'allout)
(make-variable-buffer-local 'outline-stylish-prefixes)
;;;_ = outline-numbered-bullet
-(defvar outline-numbered-bullet "#"
+(defcustom outline-numbered-bullet "#"
"*String designating bullet of topics that have auto-numbering; nil for none.
-Topics having this bullet have automatic maintainence of a sibling
+Topics having this bullet have automatic maintenance 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.")
+disables numbering maintenance."
+ :type '(choice (const nil) string)
+ :group 'allout)
(make-variable-buffer-local 'outline-numbered-bullet)
;;;_ = outline-file-xref-bullet
-(defvar outline-file-xref-bullet "@"
+(defcustom 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.")
+Set this var to the bullet you want to use for file cross-references."
+ :type '(choice (const nil) string)
+ :group 'allout)
+
+;;;_ = outline-presentation-padding
+(defcustom outline-presentation-padding 2
+ "*Presentation-format white-space padding factor, for greater indent."
+ :type 'integer
+ :group 'allout)
+
+(make-variable-buffer-local 'outline-presentation-padding)
+
+;;;_ = outline-abbreviate-flattened-numbering
+(defcustom outline-abbreviate-flattened-numbering nil
+ "*If non-nil, `outline-flatten-exposed-to-buffer' abbreviates topic
+numbers to minimal amount with some context. Otherwise, entire
+numbers are always used."
+ :type 'boolean
+ :group 'allout)
;;;_ + LaTeX formatting
;;;_ - outline-number-pages
-(defvar outline-number-pages nil
- "*Non-nil turns on page numbering for LaTeX formatting of an outline.")
+(defcustom outline-number-pages nil
+ "*Non-nil turns on page numbering for LaTeX formatting of an outline."
+ :type 'boolean
+ :group 'allout)
;;;_ - outline-label-style
-(defvar outline-label-style "\\large\\bf"
- "*Font and size of labels for LaTeX formatting of an outline.")
+(defcustom outline-label-style "\\large\\bf"
+ "*Font and size of labels for LaTeX formatting of an outline."
+ :type 'string
+ :group 'allout)
;;;_ - outline-head-line-style
-(defvar outline-head-line-style "\\large\\sl "
- "*Font and size of entries for LaTeX formatting of an outline.")
+(defcustom outline-head-line-style "\\large\\sl "
+ "*Font and size of entries for LaTeX formatting of an outline."
+ :type 'string
+ :group 'allout)
;;;_ - outline-body-line-style
-(defvar outline-body-line-style " "
- "*Font and size of entries for LaTeX formatting of an outline.")
+(defcustom outline-body-line-style " "
+ "*Font and size of entries for LaTeX formatting of an outline."
+ :type 'string
+ :group 'allout)
;;;_ - outline-title-style
-(defvar outline-title-style "\\Large\\bf"
- "*Font and size of titles for LaTeX formatting of an outline.")
+(defcustom outline-title-style "\\Large\\bf"
+ "*Font and size of titles for LaTeX formatting of an outline."
+ :type 'string
+ :group 'allout)
;;;_ - outline-title
-(defvar outline-title '(or buffer-file-name (current-buffer-name))
+(defcustom outline-title '(or buffer-file-name (current-buffer-name))
"*Expression to be evaluated to determine the title for LaTeX
-formatted copy.")
+formatted copy."
+ :type 'sexp
+ :group 'allout)
;;;_ - outline-line-skip
-(defvar outline-line-skip ".05cm"
- "*Space between lines for LaTeX formatting of an outline.")
+(defcustom outline-line-skip ".05cm"
+ "*Space between lines for LaTeX formatting of an outline."
+ :type 'string
+ :group 'allout)
;;;_ - outline-indent
-(defvar outline-indent ".3cm"
- "*LaTeX formatted depth-indent spacing.")
+(defcustom outline-indent ".3cm"
+ "*LaTeX formatted depth-indent spacing."
+ :type 'string
+ :group 'allout)
;;;_ + Miscellaneous customization
+;;;_ = outline-command-prefix
+(defcustom outline-command-prefix "\C-c"
+ "*Key sequence to be used as prefix for outline mode command key bindings."
+ :type 'string
+ :group 'allout)
+
;;;_ = outline-keybindings-list
-;;; You have to reactivate outline-mode - '(outline-mode t)' - to
+;;; 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.
+ "*List of outline-mode key / function bindings, for outline-mode-map.
-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.")
+String or vector key will be prefaced with outline-command-prefix,
+unless optional third, non-nil element is present.")
(setq outline-keybindings-list
'(
; Motion commands:
- ("?t" outline-latexify-exposed)
("\C-n" outline-next-visible-heading)
("\C-p" outline-previous-visible-heading)
("\C-u" outline-up-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-i" outline-show-children)
("\C-s" outline-show-current-subtree)
(">" outline-shift-in)
("<" outline-shift-out)
("\C-m" outline-rebullet-topic)
- ("b" outline-rebullet-current-heading)
+ ("*" 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-@" outline-mark-topic)
+ ;([?\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.")
+ ("=c" outline-copy-exposed-to-buffer)
+ ("=i" outline-indented-exposed-to-buffer)
+ ("=t" outline-latexify-exposed)
+ ("=p" outline-flatten-exposed-to-buffer)))
+
+;;;_ = outline-isearch-dynamic-expose
+(defcustom outline-isearch-dynamic-expose t
+ "*Non-nil enable dynamic exposure of hidden incremental-search
+targets as they're encountered."
+ :type 'boolean
+ :group 'allout)
+(make-variable-buffer-local 'outline-isearch-dynamic-expose)
;;;_ = outline-use-hanging-indents
-(defvar outline-use-hanging-indents t
+(defcustom 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.]")
+\[This feature no longer depends in any way on the `filladapt.el'
+lisp-archive package.\]"
+ :type 'boolean
+ :group 'allout)
(make-variable-buffer-local 'outline-use-hanging-indents)
;;;_ = outline-reindent-bodies
-(defvar outline-reindent-bodies outline-use-hanging-indents
+(defcustom outline-reindent-bodies (if outline-use-hanging-indents
+ 'text)
"*Non-nil enables auto-adjust of topic body hanging indent with depth shifts.
-Indented hanging bodies are adjusted to remain even with \(or
-right-indented from\) the beginning of heading text.")
+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.
+
+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."
+ :type '(choice (const nil) (const t) (const text) (const force))
+ :group 'allout)
+
(make-variable-buffer-local 'outline-reindent-bodies)
;;;_ = outline-inhibit-protection
-(defvar outline-inhibit-protection nil
+(defcustom 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
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.")
+behavior."
+ :type 'boolean
+ :group 'allout)
;;;_* CODE - no user customizations below.
-;;;_ #1 Internal Outline Formatting and Configuration
-;;;_ - Version
+;;;_ #1 Internal Outline Formatting and Configuration
+;;;_ : Version
;;;_ = outline-version
(defvar outline-version
- (let ((rcs-rev "$Revision: 4.1 $"))
+ (let ((rcs-rev "$Revision: 1.33 $"))
(condition-case err
(save-match-data
- (string-match "\\$Revision: \\([0-9]+\\.[0-9]+\\)" rcs-rev)
+ (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. (Currently
-specific to allout.el.)")
+ ('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))
+ (if here (insert msg))
(message "%s" msg)
msg))
-;;;_ - Topic header format
+;;;_ : Topic header format
;;;_ = outline-regexp
(defvar outline-regexp ""
"*Regular expression to match the beginning of a heading line.
(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 produced from the elements of 'outline-plain-bullets-string'
-and 'outline-distinctive-bullets-string'.")
+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-bullets-string-len
(defvar outline-bullets-string-len 0
(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
+\(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
(defvar outline-bob-regexp ()
"Like outline-line-boundary-regexp, for headers at beginning of buffer.
-(match-beginning 2) and (match-end 2) delimit the prefix.")
+\(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))
(make-variable-buffer-local 'outline-plain-bullets-string-len)
-;;;_ > outline-reset-header-lead (header-lead)
+;;;_ X outline-reset-header-lead (header-lead)
(defun outline-reset-header-lead (header-lead)
"*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)
+;;;_ 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.
(setq outline-reindent-bodies nil)
(outline-reset-header-lead header-lead)
header-lead)
-;;;_ > outline-infer-header-lead (&optional reset)
-(defun outline-infer-header-lead (&optional set)
+;;;_ > 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'.
-Optional arg SET means to do the processing to establish that prefix
-for current outline processing, if it has changed from prior setting."
+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
(and (memq use-leader '(t comment-start))
comment-start
;; Use comment-start, maybe tripled, and with
- ;; underscore:
+ ;; underscore:
(concat
(if (string= " "
(substring comment-start
(if (string= leader outline-header-prefix)
nil ; no change, nothing to do.
(setq outline-header-prefix leader)
- (if set (outline-reset-header-lead outline-header-prefix))
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.
;; Derive outline-bullets-string from user configured components:
(setq outline-bullets-string "")
(let ((strings (list 'outline-plain-bullets-string
- 'outline-distinctive-bullets-string))
+ 'outline-distinctive-bullets-string
+ 'outline-primary-bullet))
cur-string
cur-len
cur-char
(setq outline-bob-regexp
(concat "\\(\\`\\)\\(" outline-regexp "\\)"))
)
-;;;_ - Key bindings
+;;;_ : 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)
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))))))
+ (let ((map (or base-map (make-sparse-keymap)))
+ (pref (list outline-command-prefix)))
+ (mapcar (function
+ (lambda (cell)
+ (let ((add-pref (null (cdr (cdr cell))))
+ (key-suff (list (car cell))))
+ (apply 'define-key
+ (list map
+ (apply 'concat (if add-pref
+ (append pref key-suff)
+ key-suff))
+ (car (cdr cell)))))))
keymap-list)
map))
;;;_ = outline-prior-bindings - being deprecated.
-(defvar outline-prior-bindings nil
+(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
+(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
+;;;_ : Menu bar
+(defun produce-outline-mode-menubar-entries ()
+ (require 'easymenu)
+ (easy-menu-define outline-mode-exposure-menu
+ outline-mode-map
+ "Allout outline exposure menu."
+ '("Exposure"
+ ["Show Entry" outline-show-current-entry t]
+ ["Show Children" outline-show-children t]
+ ["Show Subtree" outline-show-current-subtree t]
+ ["Hide Subtree" outline-hide-current-subtree t]
+ ["Hide Leaves" outline-hide-current-leaves t]
+ "----"
+ ["Show All" outline-show-all t]))
+ (easy-menu-define outline-mode-editing-menu
+ outline-mode-map
+ "Allout outline editing menu."
+ '("Headings"
+ ["Open Sibling" outline-open-sibtopic t]
+ ["Open Subtopic" outline-open-subtopic t]
+ ["Open Supertopic" outline-open-supertopic t]
+ "----"
+ ["Shift Topic In" outline-shift-in t]
+ ["Shift Topic Out" outline-shift-out t]
+ ["Rebullet Topic" outline-rebullet-topic t]
+ ["Rebullet Heading" outline-rebullet-current-heading t]
+ ["Number Siblings" outline-number-siblings t]))
+ (easy-menu-define outline-mode-navigation-menu
+ outline-mode-map
+ "Allout outline navigation menu."
+ '("Navigation"
+ ["Next Visible Heading" outline-next-visible-heading t]
+ ["Previous Visible Heading"
+ outline-previous-visible-heading t]
+ "----"
+ ["Up Level" outline-up-current-level t]
+ ["Forward Current Level" outline-forward-current-level t]
+ ["Backward Current Level"
+ outline-backward-current-level t]
+ "----"
+ ["Beginning of Entry"
+ outline-beginning-of-current-entry t]
+ ["End of Entry" outline-end-of-current-entry t]
+ ["End of Subtree" outline-end-of-current-subtree t]))
+ (easy-menu-define outline-mode-misc-menu
+ outline-mode-map
+ "Allout outlines miscellaneous bindings."
+ '("Misc"
+ ["Version" outline-version t]
+ "----"
+ ["Duplicate Exposed" outline-copy-exposed-to-buffer t]
+ ["Duplicate Exposed, numbered"
+ outline-flatten-exposed-to-buffer t]
+ ["Duplicate Exposed, indented"
+ outline-indented-exposed-to-buffer t]
+ "----"
+ ["Set Header Lead" outline-reset-header-lead t]
+ ["Set New Exposure" outline-expose-topic t])))
+;;;_ : Mode-Specific Variable Maintenance Utilities
;;;_ = outline-mode-prior-settings
(defvar outline-mode-prior-settings nil
"Internal outline mode use; settings to be resumed on mode deactivation.")
from the list."
(let ((on-list (assq name outline-mode-prior-settings))
- prior-capsule ; By 'capsule' i mean a list
+ prior-capsule ; By `capsule' i mean a list
; containing a value, so we can
; distinguish nil from no value.
)
(cdr outline-mode-prior-settings)))
(setq outline-mode-prior-settings rebuild)))))
)
-;;;_ - Mode-specific incidentals
+;;;_ : 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-pre-was-isearching nil
+(defvar outline-pre-was-isearching nil
+ "Cue for isearch-dynamic-exposure mechanism, implemented in
+outline-pre- and -post-command-hooks.")
+(make-variable-buffer-local 'outline-pre-was-isearching)
+;;;_ = outline-isearch-prior-pos nil
+(defvar outline-isearch-prior-pos nil
+ "Cue for isearch-dynamic-exposure tracking, used by outline-isearch-expose.")
+(make-variable-buffer-local 'outline-isearch-prior-pos)
+;;;_ = outline-isearch-did-quit
+(defvar outline-isearch-did-quit nil
+ "Distinguishes isearch conclusion and cancellation.
+
+Maintained by outline-isearch-abort \(which is wrapped around the real
+isearch-abort), and monitored by outline-isearch-expose for action.")
+(make-variable-buffer-local 'outline-isearch-did-quit)
;;;_ = 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,
+against inadvertent, 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))))
+ "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.")
+the way that before-change-functions and undo interact.")
(make-variable-buffer-local 'outline-undo-aggregation)
;;;_ = file-var-bug hack
-(defvar outline-v18/9-file-var-hack nil
+(defvar outline-v18/19-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.")
(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."
+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)
'outline-mode)
;;;_ = outline-explicitly-deactivated
(defvar outline-explicitly-deactivated nil
- "Outline-mode was last deliberately deactived.
+ "Outline-mode was last deliberately deactivated.
So outline-post-command-business should not reactivate it...")
(make-variable-buffer-local 'outline-explicitly-deactivated)
-;;;_ > outline-init (mode)
-(defun outline-init (mode)
+;;;_ > outline-init (&optional mode)
+(defun outline-init (&optional mode)
"Prime outline-mode to enable/disable auto-activation, wrt `outline-layout'.
-MODE is one of:
+MODE is one of the following symbols:
- - nil, for no auto-activation,
- - `activation', for auto-activation only,
- - `ask' for auto-activation and auto-layout on confirmation from user,
- - anything else, for auto-activation and auto-layout, without any
- confirmation check.
+ - nil \(or no argument) deactivate auto-activation/layout;
+ - `activate', enable auto-activation only;
+ - `ask', enable auto-activation, and enable auto-layout but with
+ confirmation for layout operation solicited 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
\(require 'allout)
\(outline-init t)"
- (if (not mode)
+ (interactive)
+ (if (interactive-p)
(progn
- (setq find-file-hooks (delq 'outline-find-file-hook find-file-hooks))
- (if (interactive-p)
- (message "Allout outline mode auto-activation inhibited.")))
- (add-hook 'find-file-hooks 'outline-find-file-hook)
- (setq outline-auto-activation
- (cond ((eq mode 'activation)
- (message "Allout outline mode auto-activation enabled.")
- 'activate)
- ((eq mode 'ask)
- (message "Allout outline mode auto-activation enabled.")
- 'ask)
- ((message
- "Allout outline mode auto-activation and -layout enabled.")
- t)))
+ (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)))))))
-t)))))
+;;;_ > outline-setup-menubar ()
+(defun outline-setup-menubar ()
+ "Populate the current buffer's menubar with allout outline-mode stuff."
+ (let ((menus (list outline-mode-exposure-menu
+ outline-mode-editing-menu
+ outline-mode-navigation-menu
+ outline-mode-misc-menu))
+ cur)
+ (while menus
+ (setq cur (car menus)
+ menus (cdr menus))
+ (easy-menu-add cur))))
;;;_ > outline-mode (&optional toggle)
;;;_ : Defun:
(defun outline-mode (&optional toggle)
;;;_ . 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.
+Optional arg forces mode to re-initialize iff arg is positive num or
+symbol. Allout outline mode always runs as a minor mode.
+
+Allout outline mode provides extensive outline-oriented formatting and
+manipulation. It enables structural editing of outlines, as well as
+navigation and exposure. It also is specifically aimed at
+accommodating syntax-sensitive text like programming languages. \(For
+an example, see the allout code itself, which is organized as an allout
+outline.)
-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.\)
+In addition to outline navigation and exposure, allout includes:
-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.
+ - topic-oriented repositioning, cut, and paste
+ - integral outline exposure-layout
+ - incremental search with dynamic exposure and reconcealment of hidden text
+ - automatic topic-number maintenance
+ - \"Hot-spot\" operation, for single-keystroke maneuvering and
+ exposure control. \(See the outline-mode docstring.)
-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.
+and many other features.
Below is a description of the bindings, and then explanation of
-special outline-mode features and terminology.
+special outline-mode features and terminology. See also the outline
+menubar additions for quick reference to many of the features, and see
+the docstring of the variable `outline-init' for instructions on
+priming your emacs session for automatic activation of outline-mode.
-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.
+
+The bindings are dictated by the `outline-keybindings-list' and
+`outline-command-prefix' variables.
Navigation: Exposure Control:
---------- ----------------
---------------------------------
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
+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
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 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'.
+C-c C-SPC outline-mark-topic
+C-c = c outline-copy-exposed-to-buffer
+ Duplicate outline, sans concealed text, to
+ buffer with name derived from derived from
+ that of current buffer - \"*XXX exposed*\".
+C-c = p outline-flatten-exposed-to-buffer
+ Like above 'copy-exposed', but convert topic
+ prefixes to section.subsection... numeric
+ format.
ESC ESC (outline-init t) Setup emacs session for outline mode
auto-activation.
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.
+ 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
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 '.'.
+ 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.
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
+ 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.
EXPOSURE:
The state of a topic which determines the on-screen visibility
- of its' offspring and contained text.
+ 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.)
+ 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."
+OPEN: A topic that is not closed, though its offspring or body may be."
;;;_ . Code
(interactive "P")
(let* ((active (and (not (equal major-mode 'outline))
(outline-mode-p)))
- ; Massage universal-arg 'toggle' val:
+ ; Massage universal-arg `toggle' val:
(toggle (and toggle
(or (and (listp toggle)(car toggle))
toggle)))
- ; Activation specficially demanded?
+ ; Activation specifically demanded?
(explicit-activation (or
;;
(and 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
+ (same-complex-command (eq outline-v18/19-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))
+ (setq outline-v18/19-file-var-hack (car command-history))
(cond
(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))
; Revoke those keys that remain
; as we set them:
(let ((curr-loc (current-local-map)))
- (mapcar '(lambda (cell)
+ (mapcar (function
+ (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))))
+ (assq (car cell) outline-prior-bindings)))))
outline-added-bindings)
(outline-resumptions 'outline-added-bindings)
(outline-resumptions 'outline-prior-bindings)))
(outline-resumptions 'outline-primary-bullet)
(outline-resumptions 'outline-old-style-prefixes)))
(outline-resumptions 'selective-display)
- (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))
+ (if (and (boundp 'before-change-functions) before-change-functions)
+ (outline-resumptions 'before-change-functions))
(setq local-write-file-hooks
(delq 'outline-write-file-hook
local-write-file-hooks))
(outline-resumptions 'outline-old-style-prefixes '(()))))
(outline-infer-header-lead)
+ (outline-infer-body-reindent)
(set-outline-regexp)
; epoch, minor-mode key bindings:
(setq outline-mode-map
(produce-outline-mode-map outline-keybindings-list))
+ (produce-outline-mode-menubar-entries)
(fset 'outline-mode-map outline-mode-map)
; Include on minor-mode-map-alist,
; if not already there:
(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-resumptions 'before-change-functions
'(outline-before-change-protect)))
+ (add-hook 'pre-command-hook 'outline-pre-command-business)
+ (add-hook 'post-command-hook 'outline-post-command-business)
; Temporarily set by any outline
; functions that can be trusted to
; deal properly with concealed text.
(setq minor-mode-alist
(cons '(outline-mode " Outl") minor-mode-alist)))
+ (outline-setup-menubar)
+
(if outline-layout
(setq do-layout t))
- (if outline-enwrap-isearch-mode
+ (if (and outline-isearch-dynamic-expose
+ (not (fboundp 'outline-real-isearch-abort)))
(outline-enwrap-isearch))
(run-hooks 'outline-mode-hook)
(setq outline-mode t))
;; Reactivation:
- ((setq do-layout t))
+ ((setq do-layout t)
+ (outline-infer-body-reindent))
) ; cond
(if (and do-layout
(buffer-name)
outline-layout))
t
- (message "Not doing %s layout.")
+ (message "Skipped %s layout." (buffer-name))
nil)
t)))
(save-excursion
(message "Adjusting '%s' exposure..." (buffer-name))
(goto-char 0)
- (if (not (outline-goto-prefix))
- (outline-next-heading))
- (apply 'outline-expose-topic (list outline-layout))
- (message "Adjusting '%s' exposure... done." (buffer-name))))
+ (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
+;;;_ > outline-minor-mode
+;;; XXX released verion doesn't do this?
+(defalias 'outline-minor-mode 'outline-mode)
;;;_ #3 Internal Position State-Tracking - "outline-recent-*" funcs
;;; All the basic outline functions that directly do string matches to
(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))))
+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.
(beginning-of-line)
(and (looking-at outline-regexp)
(outline-prefix-data (match-beginning 0) (match-end 0)))))
+;;;_ > outline-on-heading-p ()
+(defalias 'outline-on-heading-p 'outline-on-current-heading-p)
;;;_ > outline-e-o-prefix-p ()
(defun outline-e-o-prefix-p ()
"True if point is located where current topic prefix ends, heading begins."
'(not (outline-hidden-p)))
;;;_ : Location attributes
;;;_ > outline-depth ()
-(defmacro outline-depth ()
+(defsubst 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))))
+ (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."
(buffer-substring (- outline-recent-prefix-end 1)
outline-recent-prefix-end))
;; Quick and dirty provision, ostensibly for missing bullet:
- (args-out-of-range nil))
+ ('args-out-of-range nil))
)
;;;_ > outline-get-prefix-bullet (prefix)
(defun outline-get-prefix-bullet (prefix)
;; oughtn't be called then, so forget about it...
(if (string-match outline-regexp prefix)
(substring prefix (1- (match-end 0)) (match-end 0))))
+;;;_ > outline-sibling-index (&optional depth)
+(defun outline-sibling-index (&optional depth)
+ "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 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 (outline-recent-depth) nil)
+ (setq index (1+ index)))
+ index))
+ ((< depth (outline-recent-depth))
+ (outline-ascend-to-depth depth)
+ (outline-sibling-index))
+ (0))))
+;;;_ > outline-topic-flat-index ()
+(defun outline-topic-flat-index ()
+ "Return a list indicating point's numeric section.subsect.subsubsect...
+Outermost is first."
+ (let* ((depth (outline-depth))
+ (next-index (outline-sibling-index depth))
+ (rev-sibls nil))
+ (while (> next-index 0)
+ (setq rev-sibls (cons next-index rev-sibls))
+ (setq depth (1- depth))
+ (setq next-index (outline-sibling-index depth)))
+ rev-sibls)
+ )
;;;_ - Navigation macros
;;;_ > outline-next-heading ()
-(defmacro outline-next-heading ()
+(defsubst 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)))
+ (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)))))
+ (if (re-search-forward outline-line-boundary-regexp nil 0)
+ (outline-prefix-data ; Got valid location state - set vars:
+ (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.
(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
+ (outline-prefix-data
(goto-char (or (match-beginning 2)
outline-recent-prefix-beginning))
(or (match-end 2) outline-recent-prefix-end))))))
;;; 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.
+;;; for assessment or adjustment of the subtree, without redundant
+;;; traversal of the structure.
;;;_ > 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
+Optional argument LEVELS specifies the depth \(relative 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
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.
+ (let ((original (not orig-depth)) ; `orig-depth' set only in recursion.
chart curr-depth)
(if original ; Just starting?
;; 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)))
(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)))
+ (while (and (<= curr-depth
+ (outline-recent-depth))
+ (outline-next-heading))))
(outline-next-heading)))
((and (< prev-depth curr-depth)
; the original level. Position
; to the end of it:
(progn (and (not (eobp)) (forward-char -1))
- (and (memq (preceding-char) '(?\n ?\^M))
+ (and (memq (preceding-char) '(?\n ?\r))
(memq (aref (buffer-substring (max 1 (- (point) 3))
(point))
1)
- '(?\n ?\^M))
+ '(?\n ?\r))
(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'
+Effectively a top-level chart of siblings. See `outline-chart-subtree'
for an explanation of charts."
(save-excursion
(if (outline-goto-prefix)
result))
;;;_ X outline-chart-spec (chart spec &optional exposing)
(defun outline-chart-spec (chart spec &optional exposing)
- "Not yet \(if ever\) implemented.
+ "Not yet \(if ever) implemented.
Produce exposure directives given topic/subtree CHART and an exposure SPEC.
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.
+ opened.
- Lists signify the beginning and end points of regions that should
- be flagged, and the flag to employ. (For concealment: '\(\?r\)', and
+ be flagged, and the flag to employ. (For concealment: `\(\?r\)', and
exposure:"
(while spec
- (cond ((listp 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 immediately containing topic.
+ "Put point at beginning of immediately containing outline topic.
-Goes to first subsequent topic if none immediately containing.
+Goes to most immediate 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."
+Returns the point at the beginning of the prefix, or nil if none."
(let (done)
(while (and (not done)
(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)))
+ ((outline-next-heading))
(done))
done)))
;;;_ > outline-end-of-prefix ()
'move)
(outline-prefix-data (match-beginning 1)(match-end 1))))
(if (interactive-p) (outline-end-of-prefix))))
+;;;_ > outline-back-to-heading ()
+(defalias 'outline-back-to-heading 'outline-back-to-current-heading)
;;;_ > outline-pre-next-preface ()
(defun outline-pre-next-preface ()
"Skip forward to just before the next heading line.
(> (outline-recent-depth) level))
(outline-next-heading))
(and (not (eobp)) (forward-char -1))
- (and (memq (preceding-char) '(?\n ?\^M))
+ (and (memq (preceding-char) '(?\n ?\r))
(memq (aref (buffer-substring (max 1 (- (point) 3)) (point)) 1)
- '(?\n ?\^M))
+ '(?\n ?\r))
(forward-char -1))
(setq outline-recent-end-of-subtree (point))))
;;;_ > outline-beginning-of-current-entry ()
(prog1 (outline-pre-next-preface)
(if (and (not (bobp))(looking-at "^$"))
(forward-char -1))))
+;;;_ > outline-end-of-current-heading ()
+(defun outline-end-of-current-heading ()
+ (interactive)
+ (outline-beginning-of-current-entry)
+ (forward-line -1)
+ (end-of-line))
+(defalias 'outline-end-of-heading 'outline-end-of-current-heading)
;;;_ - Depth-wise
;;;_ > outline-ascend-to-depth (depth)
(goto-char last-good)
nil))
(if (interactive-p) (outline-end-of-prefix))))
+;;;_ > outline-ascend ()
+(defun outline-ascend ()
+ "Ascend one level, returning t if successful, nil if not."
+ (prog1
+ (if (outline-beginning-of-level)
+ (outline-previous-heading))
+ (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.
(progn (goto-char last-good)
(if (interactive-p) (outline-end-of-prefix))
(if (not dont-complain)
- (error "Can't ascend past outermost level.")
+ (error "Can't ascend past outermost level")
(if (interactive-p) (outline-end-of-prefix))
nil))
(if (interactive-p) (outline-end-of-prefix))
(if (or (bobp) (eobp))
nil
(forward-char -1))
- (if (or (bobp) (not (memq (preceding-char) '(?\n ?\^M))))
+ (if (or (bobp) (not (memq (preceding-char) '(?\n ?\r))))
nil
(forward-char -1)
- (if (or (bobp) (not (memq (preceding-char) '(?\n ?\^M))))
+ (if (or (bobp) (not (memq (preceding-char) '(?\n ?\r))))
(forward-char -1)))
(point))
;;;_ > outline-beginning-of-level ()
"Move to the next ARG'th visible heading line, backward if arg is negative.
Move as far as possible in indicated direction \(beginning or end of
-buffer\) if headings are exhausted."
+buffer) if headings are exhausted."
(interactive "p")
(let* ((backward (if (< arg 0) (setq arg (* -1 arg))))
(if (not (interactive-p))
nil
(outline-end-of-prefix)
- (error "Hit %s level %d topic, traversed %d of %d requested."
+ (error "Hit %s level %d topic, traversed %d of %d requested"
(if backward "first" "last")
(outline-recent-depth)
(- (abs start-arg) arg)
\(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.)
+Locally bound in outline buffers to `before-change-functions', which
+in emacs 19 is run before any change to the buffer.
-Any functions which set ['this-command' to 'undo', or which set]
-'outline-override-protect' non-nil (as does, eg, outline-flag-chars)
+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
+ ; outline-override-protect
; set by functions that know what
; they're doing, eg outline internals:
(not outline-override-protect)
(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.
; until they respond:
; Then interpret the response:
(while
- (progn
+ (progn
(message (concat "Change inside concealed"
" region - do it? "
"(n or 'y'/'r'eclose)"))
t)
((eq response ??)
(message
- "'r' means 'yes, then reclose")
+ "`r' means `yes, then reclose'")
nil)
(t (message "Please answer y, n, or r")
(sit-for 1)
nil)))))
response)
- (quit nil))
+ ('quit nil))
; Continue:
(if (eq response 'reclose)
(save-excursion
- 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."
+ before-change-functions is used."
; Apply any external change func:
(if (not (outline-mode-p)) ; In outline-mode.
nil
(setq outline-override-protect nil)
+ (if outline-isearch-dynamic-expose
+ (outline-isearch-rectification))
(if outline-during-write-cue
;; Was used by outline-before-change-protect, done with it now:
(setq outline-during-write-cue 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
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."
-
- (if (and (boundp 'outline-mode)
- 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)
+The upshot is that you can get easy, single (ie, unmodified) key
+outline maneuvering operations by positioning the cursor on the bullet
+char. You stay in this mode until you use some regular
+cursor-positioning command to relocate the cursor off of a bullet
+char."
+ (if (not (outline-mode-p))
+ ;; Shouldn't be invoked if not in allout outline-mode, but just in case:
+ nil
+ ;; Register isearch status:
+ (if (and (boundp 'isearch-mode) isearch-mode)
+ (setq outline-pre-was-isearching t)
+ (setq outline-pre-was-isearching nil))
+ ;; Hot-spot navigation provisions:
+ (if (and (eq this-command 'self-insert-command)
+ (eq (point)(outline-current-bullet-pos)))
+ (let* ((this-key-num (cond
+ ((numberp last-command-char)
+ last-command-char)
+ ;; XXX Only xemacs has characterp.
+ ((and (fboundp 'characterp)
+ (characterp last-command-char))
+ (char-to-int last-command-char))
+ (t 0)))
+ mapped-binding)
+ (if (zerop this-key-num)
+ nil
; Map upper-register literals
; to lower register:
- (if (<= 96 this-key-num)
- (setq this-key-num (- this-key-num 32)))
+ (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)))))
+ (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.
(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)
+;;;_ > outline-isearch-rectification
+(defun outline-isearch-rectification ()
+ "Rectify outline exposure before, during, or after isearch.
+
+Called as part of outline-post-command-business."
+
+ (let ((isearching (and (boundp 'isearch-mode) isearch-mode)))
+ (cond ((and isearching (not outline-pre-was-isearching))
+ (outline-isearch-expose 'start))
+ ((and isearching outline-pre-was-isearching)
+ (outline-isearch-expose 'continue))
+ ((and (not isearching) outline-pre-was-isearching)
+ (outline-isearch-expose 'final))
+ ;; Not and wasn't isearching:
+ (t (setq outline-isearch-prior-pos nil)
+ (setq outline-isearch-did-quit nil)))))
+;;;_ = outline-isearch-was-font-lock
+(defvar outline-isearch-was-font-lock
+ (and (boundp 'font-lock-mode) font-lock-mode))
+
+;;;_ > 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-isearch-expose (mode)
+(defun outline-isearch-expose (mode)
+ "Mode is either 'clear, 'start, 'continue, or 'final."
+ ;; outline-isearch-prior-pos encodes exposure status of prior pos:
+ ;; (pos was-vis header-pos end-pos)
+ ;; pos - point of concern
+ ;; was-vis - t, else 'topic if entire topic was exposed, 'entry otherwise
+ ;; Do reclosure or prior pos, as necessary:
+ (if (eq mode 'start)
+ (setq outline-isearch-was-font-lock (and (boundp 'font-lock-mode)
+ font-lock-mode)
+ font-lock-mode nil)
+ (if (eq mode 'final)
+ (setq font-lock-mode outline-isearch-was-font-lock))
+ (if (and outline-isearch-prior-pos
+ (listp outline-isearch-prior-pos))
+ ;; Conceal prior peek:
+ (outline-flag-region (car (cdr outline-isearch-prior-pos))
+ (car (cdr (cdr outline-isearch-prior-pos)))
+ ?\r)))
+ (if (outline-visible-p)
+ (setq outline-isearch-prior-pos nil)
+ (if (not (eq mode 'final))
+ (setq outline-isearch-prior-pos (cons (point) (outline-show-entry)))
+ (if outline-isearch-did-quit
+ nil
+ (setq outline-isearch-prior-pos nil)
+ (outline-show-children))))
+ (setq outline-isearch-did-quit nil))
+;;;_ > outline-enwrap-isearch ()
+(defun outline-enwrap-isearch ()
+ "Impose outline-mode isearch-abort wrapper for dynamic exposure in isearch.
+
+The function checks to ensure that the rebinding is done only once."
+
+ (add-hook 'isearch-mode-end-hook 'outline-isearch-rectification)
+ (if (fboundp 'outline-real-isearch-abort)
+ ;;
+ nil
+ ; Ensure load of isearch-mode:
+ (if (or (and (fboundp 'isearch-mode)
+ (fboundp 'isearch-abort))
+ (condition-case error
+ (load-library "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-isearch-dynamic-expose 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:
+ (fset 'outline-real-isearch-abort (symbol-function 'isearch-abort))
+ (fset 'isearch-abort 'outline-isearch-abort)))))
+;;;_ > outline-isearch-abort ()
+(defun outline-isearch-abort ()
+ "Wrapper for outline-real-isearch-abort \(which see), to register
+actual quits."
+ (interactive)
+ (setq outline-isearch-did-quit nil)
+ (condition-case what
+ (outline-real-isearch-abort)
+ ('quit (setq outline-isearch-did-quit t)
+ (signal 'quit nil))))
+
+;;; Prevent unnecessary font-lock while isearching!
+(defvar isearch-was-font-locking nil)
+(defun isearch-inhibit-font-lock ()
+ "Inhibit font-lock while isearching - for use on isearch-mode-hook."
+ (if (and (outline-mode-p) (boundp 'font-lock-mode) font-lock-mode)
+ (setq isearch-was-font-locking t
+ font-lock-mode nil)))
+(add-hook 'isearch-mode-hook 'isearch-inhibit-font-lock)
+(defun isearch-reenable-font-lock ()
+ "Reenable font-lock after isearching - for use on isearch-mode-end-hook."
+ (if (and (boundp 'font-lock-mode) font-lock-mode)
+ (if (and (outline-mode-p) isearch-was-font-locking)
+ (setq isearch-was-font-locking nil
+ font-lock-mode t))))
+(add-hook 'isearch-mode-end-hook 'isearch-reenable-font-lock)
;;;_ - Topic Format Assessment
;;;_ > outline-solicit-alternate-bullet (depth &optional current-bullet)
Offer one suitable for current depth DEPTH as default."
- (let* ((default-bullet (or current-bullet
+ (let* ((default-bullet (or (and (stringp current-bullet) 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): "
- sans-escapes
- default-bullet)
- sans-escapes
- t)))
+ choice)
+ (save-excursion
+ (goto-char (outline-current-bullet-pos))
+ (setq choice (solicit-char-in-string
+ (format "Select bullet: %s ('%s' default): "
+ sans-escapes
+ default-bullet)
+ sans-escapes
+ t)))
+ (message "")
(if (string= choice "") default-bullet choice))
)
-;;;_ > outline-sibling-index (&optional depth)
-(defun outline-sibling-index (&optional depth)
- "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 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 (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)
(defun outline-distinctive-bullet (bullet)
"True if bullet is one of those on outline-distinctive-bullets-string."
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.)
+If SOLICIT is non-nil, then the choice of bullet is solicited from
+user. If it's a character, then that character is offered as the
+default, otherwise the one suited to the context \(according to
+distinction or depth) is offered. \(This overrides other options,
+including, eg, a distinctive PRIOR-BULLET.) If non-nil, then the
+context-specific bullet is used.
-Fifth arg, NUMBER-CONTROL, matters only if 'outline-numbered-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.
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
+sequential renumbering to not require this function counting back the
index for each successive sibling)."
;;;_ . Code:
;; The options are ordered in likely frequence of use, most common
((progn (setq body (make-string (- depth 2) ?\ ))
;; The actual condition:
solicit)
- (let* ((got (outline-solicit-alternate-bullet depth)))
+ (let* ((got (outline-solicit-alternate-bullet depth solicit)))
;; Gotta check whether we're numbering and got a numbered bullet:
(setq numbering (and outline-numbered-bullet
(not (and number-control (not index)))
((outline-sibling-index))))))
)
)
-;;;_ > outline-open-topic (relative-depth &optional before)
-(defun outline-open-topic (relative-depth &optional before)
+;;;_ > outline-open-topic (relative-depth &optional before use_sib_bullet)
+(defun outline-open-topic (relative-depth &optional before use_sib_bullet)
"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.
+If USE_SIB_BULLET is true, use the bullet of the prior sibling.
+
Nuances:
- Creation of new topics is with respect to the visible topic
- 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
+ having to go to its preceding sibling, and then open forward
from there."
(let* ((depth (+ (outline-current-depth) relative-depth))
(opening-on-blank (if (looking-at "^\$")
(not (setq before nil))))
opening-numbered ; Will get while computing ref-topic, below
- ref-depth ; Will get while computing ref-topic, next
+ ref-depth ; Will get while computing ref-topic, below
+ ref-bullet ; Will get while computing ref-topic, next
(ref-topic (save-excursion
(cond ((< relative-depth 0)
(outline-ascend-to-depth depth))
((>= relative-depth 1) nil)
(t (outline-back-to-current-heading)))
(setq ref-depth (outline-recent-depth))
+ (setq ref-bullet
+ (if (> outline-recent-prefix-end 1)
+ (outline-recent-bullet)
+ ""))
(setq opening-numbered
(save-excursion
(and outline-numbered-bullet
; Positioning and vertical
; padding - only if not
; opening-on-blank:
- (progn
+ (progn
(goto-char ref-topic)
(setq dbl-space ; Determine double space action:
(or (and (<= relative-depth 0) ; not descending;
(save-excursion
- ;; at b-o-b or preceeded by a blank line?
+ ;; at b-o-b or preceded by a blank line?
(or (> 0 (forward-line -1))
(looking-at "^\\s-*$")
(bobp)))
(not (bolp)))
(forward-char 1))))
))
- (insert-string (concat (outline-make-topic-prefix opening-numbered
- t
- depth)
- " "))
+ (insert (concat (outline-make-topic-prefix opening-numbered
+ t
+ depth)
+ " "))
;;(if doing-beginning (save-excursion (newline (if dbl-space 2 1))))
- (outline-rebullet-heading nil ;;; solicit
- depth ;;; depth
- nil ;;; number-control
- nil ;;; index
+ (outline-rebullet-heading (and use_sib_bullet ref-bullet);;; solicit
+ depth ;;; depth
+ nil ;;; number-control
+ nil ;;; index
t) (end-of-line)
)
)
;;;_ . open-topic contingencies
;;;_ ; base topic - one from which open was issued
;;;_ , beginning char
-;;;_ , amount of space before will be used, unless openning in place
+;;;_ , amount of space before will be used, unless opening 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
;;;_ ; 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.
(defun outline-open-sibtopic (arg)
"Open new topic header at same level as the current one.
+Positive universal arg means to use the bullet of the prior sibling.
+
Negative universal arg means to place the new topic prior to the current
one."
(interactive "p")
- (outline-open-topic 0 (> 0 arg)))
+ (outline-open-topic 0 (> 0 arg) (< 1 arg)))
;;;_ > outline-open-supertopic (arg)
(defun outline-open-supertopic (arg)
"Open new topic header at shallower level than the current one.
"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.
+be accommodated.
Note that refill of indented paragraphs is not done."
;; *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
nil
t)
;; Register the indent data, before we reset the
- ;; match data with a subsequent 'looking-at':
+ ;; 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)))
(indent-to (+ new-margin excess)))))))))
;;;_ > outline-rebullet-current-heading (arg)
(defun outline-rebullet-current-heading (arg)
- "Like non-interactive version 'outline-rebullet-heading'.
-
-But \(only\) affects visible heading containing point.
-
-With repeat count, solicit for bullet."
- (interactive "P")
- (save-excursion (outline-back-to-current-heading)
- (outline-end-of-prefix)
- (outline-rebullet-heading (not arg) ;;; solicit
- nil ;;; depth
- nil ;;; number-control
- nil ;;; index
- t) ;;; do-successors
- )
- )
+ "Solicit new bullet for current visible heading."
+ (interactive "p")
+ (let ((initial-col (current-column))
+ (on-bullet (eq (point)(outline-current-bullet-pos)))
+ (backwards (if (< arg 0)
+ (setq arg (* arg -1)))))
+ (while (> arg 0)
+ (save-excursion (outline-back-to-current-heading)
+ (outline-end-of-prefix)
+ (outline-rebullet-heading t ;;; solicit
+ nil ;;; depth
+ nil ;;; number-control
+ nil ;;; index
+ t)) ;;; do-successors
+ (setq arg (1- arg))
+ (if (<= arg 0)
+ nil
+ (setq initial-col nil) ; Override positioning back to init col
+ (if (not backwards)
+ (outline-next-visible-heading 1)
+ (outline-goto-prefix)
+ (outline-next-visible-heading -1))))
+ (message "Done.")
+ (cond (on-bullet (goto-char (outline-current-bullet-pos)))
+ (initial-col (move-to-column initial-col)))))
;;;_ > outline-rebullet-heading (&optional solicit ...)
(defun outline-rebullet-heading (&optional solicit
new-depth
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. If it's a character, then that character is offered as the
+default, otherwise the one suited to the context \(according to
+distinction or depth) is offered. If non-nil, then the
+context-specific bullet is just used.
Second arg DEPTH forces the topic prefix to that depth, regardless
-of the topics current depth.
+of the topic's 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
+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.
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
+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))
(delete-region (match-beginning 0)(match-end 0))))
; Put in new prefix:
- (outline-unprotected (insert-string new-prefix))
+ (outline-unprotected (insert new-prefix))
;; Reindent the body if elected and margin changed:
(if (and outline-reindent-bodies
(and on-starting-call
moving-outwards
(> 0 (+ starting-depth relative-depth))
- (error "Attempt to shift topic out beyond level 1.")) ;;; ====>
+ (error "Attempt to shift topic out beyond level 1")) ;;; ====>
(cond ((= starting-depth new-depth)
;; We're at depth to work on this one:
;; Proceed by level, processing subsequent siblings on each,
;; ascending until we get shallower than the start depth:
- (let ((ascender (outline-depth)))
+ (let ((ascender (outline-depth))
+ was-eobp)
(while (and (not (eobp))
(outline-depth)
(>= (outline-recent-depth) depth)
; Skip over all topics at
; lesser depths, which can not
; have been disturbed:
- (while (and (not (eobp))
+ (while (and (not (setq was-eobp (eobp)))
(> (outline-recent-depth) ascender))
(outline-next-heading))
; Prime ascender for ascension:
nil ;;; depth
nil ;;; number-control
nil ;;; index
- t))));;; do-successors
+ t)) ;;; do-successors
+ (if was-eobp (goto-char (point-max)))))
(outline-recent-depth))
;;;_ > outline-number-siblings (&optional denumber)
(defun outline-number-siblings (&optional denumber)
(and (outline-next-heading)
(>= (outline-recent-depth) depth))))
(forward-char 1)))
-
+
(kill-region beg (point))
(sit-for 0)
(save-excursion
2 it is being yanked at the end of a line which consists of only a valid
topic prefix.
-Also, adjusts numbering of subsequent siblings when appropropriate.
+Also, adjusts numbering of subsequent siblings when appropriate.
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
(interactive "*P")
; Get to beginning, leaving
; region around subject:
- (if (< (mark-marker) (point))
+ (if (< (my-mark-marker t) (point))
(exchange-point-and-mark))
(let* ((subj-beg (point))
- (subj-end (mark-marker))
+ (subj-end (my-mark-marker t))
;; '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
+ ;; `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)))))
(progn
(beginning-of-line)
(delete-region (point) subj-beg)
- (set-marker (mark-marker) subj-end)
+ (set-marker (my-mark-marker t) subj-end)
(goto-char subj-beg)
(outline-end-of-prefix))
; Delete base subj prefix,
(if (looking-at " ") (delete-char 1))))
(exchange-point-and-mark))))
(if rectify-numbering
- (progn
+ (progn
(save-excursion
; Give some preliminary feedback:
(message "... reconciling numbers") (sit-for 0)
(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.
+Non-topic yanks work no differently 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.
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
+Numbering of yanked topics, and the successive siblings at the depth
into which they're being yanked, is adjusted.
Outline-yank-pop works with outline-yank just like normal yank-pop
(interactive)
(if (not outline-file-xref-bullet)
(error
- "outline cross references disabled - no 'outline-file-xref-bullet'")
+ "outline cross references disabled - no `outline-file-xref-bullet'")
(if (not (string= (outline-current-bullet) outline-file-xref-bullet))
- (error "current heading lacks cross-reference bullet '%s'"
+ (error "current heading lacks cross-reference bullet `%s'"
outline-file-xref-bullet)
(let (file-name)
(save-excursion
(let* ((text-start outline-recent-prefix-end)
- (heading-end (progn (outline-pre-next-preface)
- (point))))
+ (heading-end (progn (end-of-line) (point))))
(goto-char text-start)
(setq file-name
(if (re-search-forward "\\s-\\(\\S-*\\)" heading-end t)
(setq file-name
(if (not (= (aref file-name 0) ?:))
(expand-file-name file-name)
- ; A registry-files ref, strip the ':'
+ ; A registry-files ref, strip the `:'
; and try to follow it:
(let ((reg-ref (reference-registered-file
(substring file-name 1) nil t)))
(error "%s not found and can't be created" file-name)))
(condition-case failure
(find-file-other-window file-name)
- (error failure))
+ ('error failure))
(error "%s not found" file-name))
)
)
)
)
-;;;_ #6 Exposure Control and Processing
+;;;_ #6 Exposure Control
;;;_ - 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.
(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.
(interactive)
(save-excursion
- (outline-goto-prefix)
- (outline-flag-region (if (bobp) (point) (1- (point)))
- (or (outline-pre-next-preface) (point))
- ?\n)))
+ (let ((at (point))
+ beg end)
+ (outline-goto-prefix)
+ (setq beg (if (= (preceding-char) ?\r) (1- (point)) (point)))
+ (re-search-forward "[\n\r]" nil t)
+ (setq end (1- (if (< at (point))
+ ;; We're on topic head line - show only it:
+ (point)
+ ;; or we're in body - include it:
+ (max beg (or (outline-pre-next-preface) (point))))))
+ (outline-flag-region beg end ?\n)
+ (list beg end))))
;;;_ > outline-show-children (&optional level strict)
(defun outline-show-children (&optional level strict)
(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))
+ (progn
+ (outline-flag-region (point) (outline-snug-back) ?\n)
+ (if outline-show-bodies
+ (progn (goto-char (car to-reveal))
+ (outline-show-current-entry)))))
(while to-reveal
(goto-char (car to-reveal))
(outline-flag-region (point) (outline-snug-back) ?\n)
+ (if outline-show-bodies
+ (progn (goto-char (car to-reveal))
+ (outline-show-current-entry)))
(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.
?\r)))
;;;_ > outline-show-to-offshoot ()
(defun outline-show-to-offshoot ()
- "Like outline-show-entry, but reveals opens all concealed ancestors, as well.
+ "Like outline-show-entry, but reveals all concealed ancestors, as well.
As with outline-hide-current-entry-completely, useful for rectifying
aberrant exposure states produced by outline-show-entry."
(save-excursion
(outline-flag-region (point)
(progn (outline-end-of-current-entry) (point))
- ?\^M)))
+ ?\r)))
;;;_ > outline-show-current-entry (&optional arg)
(defun outline-show-current-entry (&optional arg)
;;;_ > 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."
+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.")
+ (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))
"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.
+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."
(let ((from (point))
(orig-eol (progn (end-of-line)
(if (not (outline-goto-prefix))
- (error "No topics found.")
+ (error "No topics found")
(end-of-line)(point)))))
- (outline-flag-current-subtree ?\^M)
+ (outline-flag-current-subtree ?\r)
(goto-char from)
(if (and (= orig-eol (progn (goto-char orig-eol)
(end-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."
+ "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)
(goto-char (point-min))
(while (not (eobp))
(outline-flag-region (point)
- (progn (outline-pre-next-preface) (point)) ?\^M)
+ (progn (outline-pre-next-preface) (point)) ?\r)
(if (not (eobp))
(forward-char
(if (looking-at "[\n\r][\n\r]")
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
+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 ':'.
+explicit specs following the `:'.
Simple (numeric and null-list) specs are interpreted as follows:
- 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'
+ : - `repeat'
apply prior element to all siblings at current level, *up to*
- those siblings that would be covered by specs following the ':'
+ 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.)
((eq curr-elem '-) (outline-show-current-entry))
((eq curr-elem ':)
(setq stay t)
- ;; Expand the 'repeat' spec to an explicit version,
+ ;; 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:
(defun outline-old-expose-topic (spec &rest followers)
"Deprecated. Use outline-expose-topic \(with different schema
-format\) instead.
+format) instead.
Dictate wholesale exposure scheme for current topic, according to SPEC.
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.
+ - `*' 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
Cursor is left at start position.
-Use this instead of obsolete 'outline-exposure'.
+Use this instead of obsolete `outline-exposure'.
Examples:
\(outline-exposure (-1 () () () 1) 0)
\(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.
+ 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
(list 'save-excursion
'(if (not (or (outline-goto-prefix)
(outline-next-heading)))
- (error "outline-new-exposure: Can't find any outline topics."))
+ (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.
+ "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."))
+ (error "Can't find any outline topics"))
(cons 'outline-old-expose-topic
- (mapcar '(lambda (x) (list 'quote x)) spec))))
+ (mapcar (function (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.
+;;;_ #7 Systematic outline presentation - copying, printing, flattening
-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.
+;;;_ - Mapping and processing of topics
+;;;_ ( See also Subtree Charting, in Navigation code.)
+;;;_ > outline-stringify-flat-index (flat-index)
+(defun outline-stringify-flat-index (flat-index &optional context)
+ "Convert list representing section/subsection/... to document string.
+
+Optional arg CONTEXT indicates interior levels to include."
+ (let ((delim ".")
+ result
+ numstr
+ (context-depth (or (and context 2) 1)))
+ ;; Take care of the explicit context:
+ (while (> context-depth 0)
+ (setq numstr (int-to-string (car flat-index))
+ flat-index (cdr flat-index)
+ result (if flat-index
+ (cons delim (cons numstr result))
+ (cons numstr result))
+ context-depth (if flat-index (1- context-depth) 0)))
+ (setq delim " ")
+ ;; Take care of the indentation:
+ (if flat-index
+ (progn
+ (while flat-index
+ (setq result
+ (cons delim
+ (cons (make-string
+ (1+ (truncate (if (zerop (car flat-index))
+ 1
+ (log10 (car flat-index)))))
+ ? )
+ result)))
+ (setq flat-index (cdr flat-index)))
+ ;; Dispose of single extra delim:
+ (setq result (cdr result))))
+ (apply 'concat result)))
+;;;_ > outline-stringify-flat-index-plain (flat-index)
+(defun outline-stringify-flat-index-plain (flat-index)
+ "Convert list representing section/subsection/... to document string."
+ (let ((delim ".")
+ result)
+ (while flat-index
+ (setq result (cons (int-to-string (car flat-index))
+ (if result
+ (cons delim result))))
+ (setq flat-index (cdr flat-index)))
+ (apply 'concat result)))
+;;;_ > outline-stringify-flat-index-indented (flat-index)
+(defun outline-stringify-flat-index-indented (flat-index)
+ "Convert list representing section/subsection/... to document string."
+ (let ((delim ".")
+ result
+ numstr)
+ ;; Take care of the explicit context:
+ (setq numstr (int-to-string (car flat-index))
+ flat-index (cdr flat-index)
+ result (if flat-index
+ (cons delim (cons numstr result))
+ (cons numstr result)))
+ (setq delim " ")
+ ;; Take care of the indentation:
+ (if flat-index
+ (progn
+ (while flat-index
+ (setq result
+ (cons delim
+ (cons (make-string
+ (1+ (truncate (if (zerop (car flat-index))
+ 1
+ (log10 (car flat-index)))))
+ ? )
+ result)))
+ (setq flat-index (cdr flat-index)))
+ ;; Dispose of single extra delim:
+ (setq result (cdr result))))
+ (apply 'concat result)))
+;;;_ > outline-listify-exposed (&optional start end format)
+(defun outline-listify-exposed (&optional start end format)
-Used by isearch-terminate/outline-provisions and
-isearch-done/outline-provisions")
+ "Produce a list representing exposed topics in current region.
-
-;;;_ > outline-enwrap-isearch ()
-(defun outline-enwrap-isearch ()
- "Impose outline-mode isearch-mode wrappers for dynamic exposure in isearch.
+This list can then be used by `outline-process-exposed' to manipulate
+the subject region.
-Isearch progressively exposes and reconceals hidden topics when
-working in outline mode, but works normally elsewhere.
+Optional START and END indicate bounds of region.
-The function checks to ensure that the rebindings are done only once."
+optional arg, FORMAT, designates an alternate presentation form for
+the prefix:
- ; Should isearch-mode be employed,
- (if (or (not outline-enwrap-isearch-mode)
- ; or are preparations already done?
- (fboundp 'real-isearch-terminate))
+ list - Present prefix as numeric section.subsection..., starting with
+ section indicated by the list, innermost nesting first.
+ `indent' \(symbol) - Convert header prefixes to all white space,
+ except for distinctive bullets.
- ;; ... no - skip this all:
- nil
+The elements of the list produced are lists that represents a topic
+header and body. The elements of that list are:
- ;; ... yes:
+ - a number representing the depth of the topic,
+ - a string representing the header-prefix, including trailing whitespace and
+ bullet.
+ - a string representing the bullet character,
+ - and a series of strings, each containing one line of the exposed
+ portion of the topic entry."
- ; 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."
+ (interactive "r")
+ (save-excursion
+ (let*
+ ;; state vars:
+ (strings prefix pad result depth new-depth out gone-out bullet beg
+ next done)
- (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
+ (goto-char start)
+ (beginning-of-line)
+ ;; Goto initial topic, and register preceeding stuff, if any:
+ (if (> (outline-goto-prefix) start)
+ ;; First topic follows beginning point - register preliminary stuff:
+ (setq result (list (list 0 "" nil
+ (buffer-substring start (1- (point)))))))
+ (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,
+ prefix (outline-recent-prefix)
+ beg (progn (outline-end-of-prefix t) (point))) ; and beginning.
+ (setq done ; The boundary for the current topic:
+ (not (outline-next-visible-heading 1)))
+ (setq new-depth (outline-recent-depth))
+ (setq gone-out out
+ out (< new-depth depth))
+ (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 strings (nreverse strings))
+ (setq result
+ (cons
+ (if format
+ (let ((special (if (string-match
+ (regexp-quote bullet)
+ outline-distinctive-bullets-string)
+ bullet)))
+ (cond ((listp format)
+ (list depth
+ (if outline-abbreviate-flattened-numbering
+ (outline-stringify-flat-index format
+ gone-out)
+ (outline-stringify-flat-index-plain
+ format))
+ strings
+ special))
+ ((eq format 'indent)
+ (if special
+ (list depth
+ (concat (make-string (1+ depth) ? )
+ (substring prefix -1))
+ strings)
+ (list depth
+ (make-string depth ? )
+ strings)))
+ (t (error "outline-listify-exposed: %s %s"
+ "invalid format" format))))
+ (list depth prefix strings))
+ result))
+ ;; Reasses format, if any:
+ (if (and format (listp format))
+ (cond ((= new-depth depth)
+ (setq format (cons (1+ (car format))
+ (cdr format))))
+ ((> new-depth depth) ; descending - assume by 1:
+ (setq format (cons 1 format)))
+ (t
+ ; Pop the residue:
+ (while (< new-depth depth)
+ (setq format (cdr format))
+ (setq depth (1- depth)))
+ ; And increment the current one:
+ (setq format
+ (cons (1+ (or (car format)
+ -1))
+ (cdr format)))))))
+ ;; Put the list with first at front, to last at back:
+ (nreverse result))))
+;;;_ > outline-process-exposed (&optional func from to frombuf
+;;; tobuf format)
+(defun outline-process-exposed (&optional func from to frombuf tobuf
+ format &optional start-num)
+ "Map function on exposed parts of current topic; results to another buffer.
-;;;_ - 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.
+All args are options; default values itemized below.
-With repeat count, copy the exposed portions of entire buffer."
+Apply FUNCTION to exposed portions FROM position TO position in buffer
+FROMBUF to buffer TOBUF. Sixth optional arg, FORMAT, designates an
+alternate presentation form:
+
+ `flat' - Present prefix as numeric section.subsection..., starting with
+ section indicated by the start-num, innermost nesting first.
+ X`flat-indented' - Prefix is like `flat' for first topic at each
+ X level, but subsequent topics have only leaf topic
+ X number, padded with blanks to line up with first.
+ `indent' \(symbol) - Convert header prefixes to all white space,
+ except for distinctive bullets.
+
+Defaults:
+ FUNCTION: `outline-insert-listified'
+ FROM: region start, if region active, else start of buffer
+ TO: region end, if region active, else end of buffer
+ FROMBUF: current buffer
+ TOBUF: buffer name derived: \"*current-buffer-name exposed*\"
+ FORMAT: nil"
+
+ ; Resolve arguments,
+ ; defaulting if necessary:
+ (if (not func) (setq func 'outline-insert-listified))
+ (if (not (and from to))
+ (if (my-region-active-p)
+ (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*")))
+ (if (listp format)
+ (nreverse format))
+
+ (let* ((listified
+ (progn (set-buffer frombuf)
+ (outline-listify-exposed from to format))))
+ (set-buffer tobuf)
+ (mapcar func listified)
+ (pop-to-buffer tobuf)))
+
+;;;_ - Copy exposed
+;;;_ > outline-insert-listified (listified)
+(defun outline-insert-listified (listified)
+ "Insert contents of listified outline portion in current buffer.
+
+Listified is a list representing each topic header and body:
+
+ \`(depth prefix text)'
+
+or \`(depth prefix text bullet-plus)'
+
+If `bullet-plus' is specified, it is inserted just after the entire prefix."
+ (setq listified (cdr listified))
+ (let ((prefix (prog1
+ (car listified)
+ (setq listified (cdr listified))))
+ (text (prog1
+ (car listified)
+ (setq listified (cdr listified))))
+ (bullet-plus (car listified)))
+ (insert prefix)
+ (if bullet-plus (insert (concat " " bullet-plus)))
+ (while text
+ (insert (car text))
+ (if (setq text (cdr text))
+ (insert "\n")))
+ (insert "\n")))
+;;;_ > outline-copy-exposed-to-buffer (&optional arg tobuf format)
+(defun outline-copy-exposed-to-buffer (&optional arg tobuf format)
+ "Duplicate exposed portions of current outline to another buffer.
+
+Other buffer has current buffers name with \" exposed\" appended to it.
+
+With repeat count, copy the exposed parts of only the current topic.
+
+Optional second arg TOBUF is target buffer name.
+
+Optional third arg FORMAT, if non-nil, symbolically designates an
+alternate presentation format for the outline:
+
+ `flat' - Convert topic header prefixes to numeric
+ section.subsection... identifiers.
+ `indent' - Convert header prefixes to all white space, except for
+ distinctive bullets.
+ `indent-flat' - The best of both - only the first of each level has
+ the full path, the rest have only the section number
+ of the leaf, preceded by the right amount of indentation."
(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)))
+ (beg (if arg (outline-back-to-current-heading) (point-min)))
+ (end (if arg (outline-end-of-current-subtree) (point-max)))
+ (buf (current-buffer))
+ (start-list ()))
+ (if (eq format 'flat)
+ (setq format (if arg (save-excursion
+ (goto-char beg)
+ (outline-topic-flat-index))
+ '(1))))
(save-excursion (set-buffer tobuf)(erase-buffer))
(outline-process-exposed 'outline-insert-listified
beg
end
(current-buffer)
- tobuf)
+ tobuf
+ format start-list)
(goto-char (point-min))
(pop-to-buffer buf)
(goto-char start-pt)))
+;;;_ > outline-flatten-exposed-to-buffer (&optional arg tobuf)
+(defun outline-flatten-exposed-to-buffer (&optional arg tobuf)
+ "Present numeric outline of outline's exposed portions in another buffer.
+
+The resulting outline is not compatable with outline mode - use
+`outline-copy-exposed-to-buffer' if you want that.
+
+Use `outline-indented-exposed-to-buffer' for indented presentation.
+
+With repeat count, copy the exposed portions of only current topic.
+
+Other buffer has current buffers name with \" exposed\" appended to
+it, unless optional second arg TOBUF is specified, in which case it is
+used verbatim."
+ (interactive "P")
+ (outline-copy-exposed-to-buffer arg tobuf 'flat))
+;;;_ > outline-indented-exposed-to-buffer (&optional arg tobuf)
+(defun outline-indented-exposed-to-buffer (&optional arg tobuf)
+ "Present indented outline of outline's exposed portions in another buffer.
+
+The resulting outline is not compatable with outline mode - use
+`outline-copy-exposed-to-buffer' if you want that.
+
+Use `outline-flatten-exposed-to-buffer' for numeric sectional presentation.
+
+With repeat count, copy the exposed portions of only current topic.
+
+Other buffer has current buffers name with \" exposed\" appended to
+it, unless optional second arg TOBUF is specified, in which case it is
+used verbatim."
+ (interactive "P")
+ (outline-copy-exposed-to-buffer arg tobuf 'indent))
;;;_ - LaTeX formatting
;;;_ > 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 '(?"" ?$ ?% ?# ?& ?- ?" ?` ?^ ?- ?*));;;"))))
+ (mapconcat (function
+ (lambda (char)
(cond ((memq char '(?\\ ?$ ?% ?# ?& ?{ ?} ?_ ?^ ?- ?*))
(concat "\\char" (number-to-string char) "{}"))
((= char ?\n) "\\\\")
- (t (char-to-string char))))
+ (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.
+ "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'
+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 ; bounded by end-of-line
1) ; no matches, move to end & return nil
(goto-char (match-beginning 0))
- (insert-string "\\")
+ (insert "\\")
(setq end (1+ end))
(goto-char (1+ (match-end 0))))))
;;;_ > outline-insert-latex-header (buf)
(outline-latex-verb-quote (if outline-title
(condition-case err
(eval outline-title)
- (error "<unnamed buffer>"))
+ ('error "<unnamed buffer>"))
"Unnamed Outline"))
"}\n"
"\\end{center}\n\n"))
(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
+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"))
+ (insert (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")
+ ;;(insert "\\beginlines\n")
+ (insert "\\begin{verbatim}\n")
(while body-lines
(setq curr-line (car body-lines))
(if (and (not body-content)
(setq curr-line (concat (substring curr-line 0 bop)
">"
(substring curr-line bop))))
- ;;(insert-string "|" (car body-lines) "|")
- (insert-string curr-line)
+ ;;(insert "|" (car body-lines) "|")
+ (insert curr-line)
(outline-latex-verbatim-quote-curr-line)
- (insert-string "\n")
+ (insert "\n")
(setq body-lines (cdr body-lines)))
(if body-content
(setq body-content nil)
(forward-char -1)
- (insert-string "\\ ")
+ (insert "\\ ")
(forward-char 1))
- ;;(insert-string "\\endlines\n")
- (insert-string "\\end{verbatim}\n")
+ ;;(insert "\\endlines\n")
+ (insert "\\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.
+ "Format current topics 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.
(pop-to-buffer buf)
(goto-char start-pt)))
-;;;_ #9 miscellaneous
+;;;_ #8 miscellaneous
;;;_ > outline-mark-topic ()
(defun outline-mark-topic ()
"Put the region around topic currently containing point."
;; 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.
+ "Activate outline mode and establish file var so it is started subsequently.
See doc-string for `outline-layout' and `outline-init' for details on
setup for auto-startup."
(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)
+ (insert (concat "Dummy outline topic header - see"
+ "`outline-mode' docstring: `^Hm'."))
+ (forward-line 1)
(goto-char (point-max))
- (next-line 1)
+ (open-line 1)
(outline-open-topic 0)
- (insert-string "Local emacs vars.\n")
+ (insert "Local emacs vars.\n")
(outline-open-topic 1)
- (insert-string "(`outline-layout' is for allout.el outline-mode)\n")
+ (insert "(`outline-layout' is for allout.el outline-mode)\n")
(outline-open-topic 0)
- (insert-string "Local variables:\n")
+ (insert "Local variables:\n")
(outline-open-topic 0)
- (insert-string (format "outline-layout: %s\n"
+ (insert (format "outline-layout: %s\n"
(or outline-layout
- '(1 : 0))))
+ '(-1 : 0))))
(outline-open-topic 0)
- (insert-string "End:\n"))))
+ (insert "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.
(message "%s" new-prompt)
;; We do our own reading here, so we can circumvent, eg, special
- ;; treatment for '?' character. (Might oughta change minibuffer
- ;; keymap instead, oh well.)
+ ;; treatment for `?' character. (Oughta use minibuffer keymap instead.)
(setq got
(char-to-string (let ((cursor-in-echo-area nil)) (read-char))))
- (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 "")
- ;; Failed match and not defaulting,
- ;; set the prompt to give feedback,
- (setq new-prompt (concat prompt
- got
- " ...pick from: "
- string
- ""))
- ;; and set loop to try again:
- (setq got nil))
- ;; Got a match - give feedback:
- (message "")))
- ;; got something out of loop - return it:
- got)
+ (setq got
+ (cond ((string-match (regexp-quote got) string) got)
+ ((and do-defaulting (string= got "\r"))
+ ;; Return empty string to default:
+ "")
+ ((string= got "\C-g") (signal 'quit nil))
+ (t
+ (setq new-prompt (concat prompt
+ got
+ " ...pick from: "
+ string
+ ""))
+ nil))))
+ ;; got something out of loop - return it:
+ got)
)
;;;_ > regexp-sans-escapes (string)
(defun regexp-sans-escapes (regexp &optional successive-backslashes)
(regexp-sans-escapes (substring regexp 1)))
;; Exclude first char, but maintain count:
(regexp-sans-escapes (substring regexp 1) successive-backslashes))))
+;;;_ > my-region-active-p ()
+(defmacro my-region-active-p ()
+ (if (fboundp 'region-active-p)
+ '(region-active-p)
+ 'mark-active))
;;;_ - 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
+\(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."
(let ((tail (assoc (cdr function) (symbol-value hook))))
(equal function tail))
(memq function (symbol-value hook)))
- (set hook
+ (set hook
(if append
(nconc (symbol-value hook) (list function))
(cons function (symbol-value hook)))))))
+;;;_ : my-mark-marker to accommodate divergent emacsen:
+(defun my-mark-marker (&optional force buffer)
+ "Accommodate the different signature for mark-marker across emacsen.
+
+GNU XEmacs takes two optional args, while mainline GNU Emacs does not,
+so pass them along when appropriate."
+ (if (string-match " XEmacs " emacs-version)
+ (mark-marker force buffer)
+ (mark-marker)))
-;;;_ #10 Under development
+;;;_ #9 Under development
;;;_ > outline-bullet-isearch (&optional bullet)
(defun outline-bullet-isearch (&optional bullet)
- "Isearch \(regexp\) for topic with bullet 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
(isearch-repeat 'forward)
(isearch-mode t)))
;;;_ ? Re hooking up with isearch - use isearch-op-fun rather than
-;;; wrapping the isearch functions.
+;;; wrapping the isearch functions.
;;;_* Local emacs vars.
;;; The following `outline-layout' local variable setting:
;;;outline-layout: (0 : -1 -1 0)
;;;End:
-;; allout.el ends here
-
+;;; allout.el ends here