-;;; 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.
;; 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.3 1994/05/12 17:43:08 klm Exp ||
-;; Keywords: outlines
+;; Version: $Id: allout.el,v 4.35 2000/02/01 15:58:14 klm Exp klm $||
+;; Keywords: outline mode wp languages
;; This file is part of GNU Emacs.
;;;_* Commentary:
;; Allout outline mode provides extensive outline formatting and
-;; manipulation capabilities, subsuming and well beyond that of
-;; standard emacs outline mode. It is specifically aimed at
-;; supporting outline structuring and manipulation of syntax-
-;; sensitive text, eg programming languages. (For an example, see the
-;; allout code itself, which is organized in outline structure.)
-;;
-;; It also includes such things as topic-oriented repositioning, cut, and
-;; paste; integral outline exposure-layout; incremental search with
-;; dynamic exposure/concealment of concealed text; automatic topic-number
-;; maintenance; and many other features.
-;;
+;; 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.)
+;;
+;; 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
;; 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
;;;_* Provide
(provide 'outline)
;;;_ + 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,
+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.
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.")
(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
(defcustom outline-header-prefix "."
:group 'allout)
(make-variable-buffer-local 'outline-primary-bullet)
;;;_ = outline-plain-bullets-string
-(defcustom 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
:group 'allout)
(make-variable-buffer-local 'outline-plain-bullets-string)
;;;_ = outline-distinctive-bullets-string
-(defcustom 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.
+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 changes
-to the value of this var to effect outline-mode operation.
+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."
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
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.]"
(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
(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 to 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
(defcustom outline-number-pages nil
;;;_ + 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
;;; 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)
("\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
-(defcustom outline-command-prefix "\C-c"
- "*Key sequence to be used as prefix for outline mode command key bindings."
- :type 'string
- :group 'allout)
-
-;;;_ = outline-enwrap-isearch-mode
-(defcustom 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
(defcustom outline-use-hanging-indents t
;;;_* 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.3"))
+ (let ((rcs-rev "$Revision: 4.35 $"))
(condition-case err
(save-match-data
(string-match "Revision: \\([0-9]+\\.[0-9]+\\)" rcs-rev)
(substring rcs-rev (match-beginning 1) (match-end 1)))
- (error rcs-rev)))
+ ('error rcs-rev)))
"Revision number of currently loaded outline package. \(allout.el)")
;;;_ > outline-version
(defun outline-version (&optional here)
(if here (insert-string 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.
;;;_ = 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))
`outline-use-mode-specific-leader'
and `outline-mode-leaders'.
-Apply this via \(re\)activation of `outline-mode', rather than
+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)
;; 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.
"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.")
(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.
(make-variable-buffer-local 'outline-override-protect)
;;;_ > outline-unprotected (expr)
(defmacro outline-unprotected (expr)
- "Evaluate EXPRESSION with `outline-override-protect' let-bound to 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.")
((message
"Outline mode auto-activation and -layout enabled.")
'full)))))))
-
+
+;;;_ > 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 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.\)
+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.)
-It also includes such things as topic-oriented repositioning, cut, and
-paste; integral outline exposure-layout; incremental search with
-dynamic exposure/concealment of concealed text; automatic topic-number
-maintenance; and many other features.
+In addition to outline navigation and exposure, allout includes:
-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.
+ - 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.
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<CR> outline-rebullet-topic Reconcile bullets of topic and its offspring
- distinctive bullets are not changed, others
alternated according to nesting depth.
-C-c * outline-rebullet-current-heading Prompt for alternate bullet for
+C-c b outline-rebullet-current-heading Prompt for alternate bullet for
current topic.
C-c # outline-number-siblings Number bullets of topic and siblings - the
offspring are not affected. With repeat
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.
(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
; 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))
; 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:
(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.
;; Paragraphs are broken by topic headlines.
(make-local-variable 'paragraph-start)
(outline-resumptions 'paragraph-start
- (list (concat paragraph-start "\\|\\("
+ (list (concat paragraph-start "\\|^\\("
outline-regexp "\\)")))
(make-local-variable 'paragraph-separate)
(outline-resumptions 'paragraph-separate
- (list (concat paragraph-separate "\\|\\("
+ (list (concat paragraph-separate "\\|^\\("
outline-regexp "\\)")))
(or (assq 'outline-mode minor-mode-alist)
(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)
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
"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))))
+ `(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."
;;; 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 \(relative to start
-depth\) for the chart. Subsequent optional args are not for public
+depth) for the chart. Subsequent optional args are not for public
use.
Charts are used to capture outline structure, so that outline-altering
;; 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)))
; 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))))
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.
;;;_ - 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.
(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 ()
t
(while (looking-at "[0-9]") (forward-char 1))
(if (and (not (eolp)) (looking-at "\\s-")) (forward-char 1)))
- (set-match-data match-data))
+ (store-match-data match-data))
;; Reestablish where we are:
(outline-current-depth)))
;;;_ > outline-current-bullet-pos ()
'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.
(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))))
\(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)
(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-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'
is non-nil *and* soliciting was not explicitly invoked. Then
((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
(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
;;(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)
)
)
;;;_ ; 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.
(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
;; 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)
(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))
- ;; `resituate' if yanking an entire topic into topic header:
+ (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)
(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,
(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)
next C-j (newline) char.
Returns the endpoint of the region."
- (` (let ((buffer-read-only nil)
+ `(let ((buffer-read-only nil)
(outline-override-protect t))
- (subst-char-in-region (, from) (, to)
- (if (= (, flag) ?\n) ?\r ?\n)
- (, flag) 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 "outline-process-exposed: source buffer %s not found."
- frombuf)
- (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)
(if (not (outline-goto-prefix))
(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)
(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]")
(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.
(outline-next-heading)))
(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.
+This list can then be used by `outline-process-exposed' to manipulate
+the subject region.
-;;;_ > outline-enwrap-isearch ()
-(defun outline-enwrap-isearch ()
- "Impose outline-mode isearch-mode wrappers for dynamic exposure in isearch.
+Optional START and END indicate bounds of region.
-Isearch progressively exposes and reconceals hidden topics when
-working in outline mode, but works normally elsewhere.
+optional arg, FORMAT, designates an alternate presentation form for
+the prefix:
-The function checks to ensure that the rebindings are done only once."
+ 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.
- ; Should isearch-mode be employed,
- (if (or (not outline-enwrap-isearch-mode)
- ; or are preparations already done?
- (fboundp 'real-isearch-terminate))
+The elements of the list produced are lists that represents a topic
+header and body. The elements of that list are:
- ;; ... no - skip this all:
- nil
+ - 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."
- ;; ... yes:
+ (interactive "r")
+ (save-excursion
+ (let*
+ ;; state vars:
+ (strings prefix pad result depth new-depth out gone-out bullet beg
+ next done)
- ; 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
+ (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.
- ;; 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."
+All args are options; default values itemized below.
- (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 edit)
- (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
+Apply FUNCTION to exposed portions FROM position TO position in buffer
+FROMBUF to buffer TOBUF. Sixth optional arg, FORMAT, designates an
+alternate presentation form:
-;;;_ - 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.
+ `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.
-With repeat count, copy the exposed portions of entire buffer."
+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-string prefix)
+ (if bullet-plus (insert-string (concat " " bullet-plus)))
+ (while text
+ (insert-string (car text))
+ (if (setq text (cdr text))
+ (insert-string "\n")))
+ (insert-string "\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'
(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 "
+ (insert-string (concat "\\OneHeadLine{\\verb\1 "
(outline-latex-verb-quote bullet)
"\1}{"
depth
)))
;;;_ > 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."
t
(outline-open-topic 2)
(insert-string (concat "Dummy outline topic header - see"
- "`outline-mode' docstring for info."))
- (next-line 1)
+ "`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")
(outline-open-topic 1)
(outline-open-topic 0)
(insert-string (format "outline-layout: %s\n"
(or outline-layout
- '(1 : 0))))
+ '(-1 : 0))))
(outline-open-topic 0)
(insert-string "End:\n"))))
;;;_ > solicit-char-in-string (prompt string &optional do-defaulting)
(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))
(if append
(nconc (symbol-value hook) (list function))
(cons function (symbol-value hook)))))))
+;;;_ : my-mark-marker to accomodate divergent emacsen:
+(defun my-mark-marker (&optional force buffer)
+ "Accomodate 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
projects / emacs.git / commitdiff