;;; allout.el --- extensive outline mode for use alone and with other modes
;; Copyright (C) 1992, 1993, 1994, 2001, 2002, 2003, 2004,
-;; 2005, 2006 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Ken Manheimer <ken dot manheimer at gmail dot com>
;; Maintainer: Ken Manheimer <ken dot manheimer at gmail dot com>
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; - Symmetric-key and key-pair topic encryption, plus symmetric passphrase
;; mnemonic support, with verification against an established passphrase
;; (using a stashed encrypted dummy string) and user-supplied hint
-;; maintenance. (See allout-toggle-current-subtree-encryption docstring.)
+;; maintenance. (See allout-toggle-current-subtree-encryption docstring.
+;; Currently only GnuPG encryption is supported, and integration
+;; with gpg-agent is not yet implemented.)
;; - Automatic topic-number maintenance
;; - "Hot-spot" operation, for single-keystroke maneuvering and
;; exposure control (see the allout-mode docstring)
;;
;; The outline menubar additions provide quick reference to many of
;; the features, and see the docstring of the variable `allout-init'
-;; for instructions on priming your emacs session for automatic
+;; for instructions on priming your Emacs session for automatic
;; activation of allout-mode.
;;
;; See the docstring of the variables `allout-layout' and
: - repeat spec - apply the preceeding element to all siblings at
current level, *up to* those siblings that would be covered by specs
following the `:' on the list. Ie, apply to all topics at level but
- trailing ones accounted for by trailing specs. \(Only the first of
+ trailing ones accounted for by trailing specs. (Only the first of
multiple colons at the same level is honored - later ones are ignored.)
* - completely exposes the topic, including bodies
+ - exposes all subtopics, but not the bodies
- if the cursor is on the headline and not the start of the headline:
then it goes to the start of the headline
- if the cursor is on the start of the headline:
- then it goes to the bullet character \(for hotspot navigation\)
+ then it goes to the bullet character (for hotspot navigation)
- if the cursor is on the bullet character:
- then it goes to the first column of that line \(the headline\)
+ then it goes to the first column of that line (the headline)
- if the cursor is on the first column of the headline:
then it goes to the start of the headline within the item body.
(defcustom allout-distinctive-bullets-string "*+-=>()[{}&!?#%\"X@$~_\\:;^"
"*Persistent outline header bullets used to distinguish special topics.
-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:
+These bullets are distinguish topics with particular character.
+They are not used by default in the topic creation routines, but
+are offered as options when you modify topic creation with a
+universal argument \(\\[universal-argument]), or during rebulleting \(\\[allout-rebullet-current-heading]).
- `?' question topics
- `\(' parenthetic comment \(with a matching close paren inside)
- `[' meta-note \(with a matching close ] inside)
- `\"' a quotation
- `=' value settings
- `~' \"more or less\"
- `^' see above
+Distinctive bullets are not cycled when topics are shifted or
+otherwise automatically rebulleted, so their marking is
+persistent until deliberately changed. Their significance is
+purely by convention, however. Some conventions suggest
+themselves:
- ... for example. (`#' typically has a special meaning to the software,
-according to the value of `allout-numbered-bullet'.)
+ `(' - open paren - an aside or incidental point
+ `?' - question mark - uncertain or outright question
+ `!' - exclamation point/bang - emphatic
+ `[' - open square bracket - meta-note, about item instead of item's subject
+ `\"' - double quote - a quotation or other citation
+ `=' - equal sign - an assignement, equating a name with some connotation
+ `^' - carat - relates to something above
-See `allout-plain-bullets-string' for the selection of
-alternating bullets.
+Some are more elusive, but their rationale may be recognizable:
+
+ `+' - plus - pending consideration, completion
+ `_' - underscore - done, completed
+ `&' - ampersand - addendum, furthermore
+
+\(Some other non-plain bullets have special meaning to the
+software. By default:
+
+ `~' marks encryptable topics - see `allout-topic-encryption-bullet'
+ `#' marks auto-numbered bullets - see `allout-numbered-bullet'.)
+
+See `allout-plain-bullets-string' for the standard, alternating
+bullets.
You must run `set-allout-regexp' in order for outline mode to
-reconcile to changes of this value.
+adopt changes of this value.
DO NOT include the close-square-bracket, `]', on either of the bullet
strings."
do not escape any regulare-expression characters.
Value t means to first check for assoc value in `allout-mode-leaders'
-alist, then use comment-start string, if any, then use default \(`.').
+alist, then use comment-start string, if any, then use default (`.').
\(See note about use of comment-start strings, below.)
Set to the symbol for either of `allout-mode-leaders' or
`comment-start' to use only one of them, respectively.
-Value nil means to always use the default \(`.') and leave
+Value nil means to always use the default (`.') and leave
`allout-primary-bullet' unaltered.
comment-start strings that do not end in spaces are tripled in
the header-prefix, and an `_' underscore is tacked on the end, to
distinguish them from regular comment strings. comment-start
strings that do end in spaces are not tripled, but an underscore
-is substituted for the space. [This presumes that the space is
+is substituted for the space. [This presumes that the space is
for appearance, not comment syntax. You can use
`allout-mode-leaders' to override this behavior, when
undesired.]"
mostly covers both deliberate file writes and auto-saves.
- Yes: encrypt all topics pending encryption, even if it's the one
- currently being edited. \(In that case, the currently edited topic
+ currently being edited. (In that case, the currently edited topic
will be automatically decrypted before any user interaction, so they
can continue editing but the copy on the file system will be
encrypted.)
- No: leave it to the user to encrypt any unencrypted topics.
For practical reasons, auto-saves always use the 'except-current policy
-when auto-encryption is enabled. \(Otherwise, spurious passphrase prompts
+when auto-encryption is enabled. (Otherwise, spurious passphrase prompts
and unavoidable timing collisions are too disruptive.) If security for a
file requires that even the current topic is never auto-saved in the clear,
disable auto-saves for that file."
("*" allout-rebullet-current-heading)
("#" allout-number-siblings)
("\C-k" allout-kill-line t)
+ ("\M-k" allout-copy-line-as-kill t)
("\C-y" allout-yank t)
("\M-y" allout-yank-pop t)
("\C-k" allout-kill-topic)
+ ("\M-k" allout-copy-topic-as-kill)
; Miscellaneous commands:
;([?\C-\ ] allout-mark-topic)
("@" allout-resolve-xref)
You can customize this setting to set it for all allout buffers, or set it
in individual buffers if you want to inhibit auto-fill only in particular
-buffers. \(You could use a function on `allout-mode-hook' to inhibit
-auto-fill according, eg, to the major mode.\)
+buffers. (You could use a function on `allout-mode-hook' to inhibit
+auto-fill according, eg, to the major mode.)
If you don't set this and auto-fill-mode is enabled, allout will use the
value that `normal-auto-fill-function', if any, when allout mode starts, or
(defcustom allout-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
+relevant mostly for use with `indented-text-mode', or other situations
where auto-fill occurs."
:type 'boolean
:group 'allout)
;;;_ : Version
;;;_ = allout-version
(defvar allout-version "2.2.1"
- "Version of currently loaded outline package. \(allout.el)")
+ "Version of currently loaded outline package. (allout.el)")
;;;_ > allout-version
(defun allout-version (&optional here)
"Return string describing the loaded outline version."
(defvar allout-layout nil ; LEAVE GLOBAL VALUE NIL - see docstring.
"Buffer-specific setting for allout layout.
-In buffers where this is non-nil \(and if `allout-init' has been run, to
+In buffers where this is non-nil (and if `allout-init' has been run, to
enable this behavior), `allout-mode' will be automatically activated. The
layout dictated by the value will be used to set the initial exposure when
`allout-mode' is activated.
example, the following lines at the bottom of an Emacs Lisp file:
;;;Local variables:
-;;;allout-layout: \(0 : -1 -1 0)
+;;;allout-layout: (0 : -1 -1 0)
;;;End:
dictate activation of `allout-mode' mode when the file is visited
\(presuming allout-init was already run), followed by the
-equivalent of `\(allout-expose-topic 0 : -1 -1 0)'. \(This is
+equivalent of `(allout-expose-topic 0 : -1 -1 0)'. (This is
the layout used for the allout.el source file.)
`allout-default-layout' describes the specification format.
(defvar allout-bullets-string-len 0
"Length of current buffers' `allout-plain-bullets-string'.")
(make-variable-buffer-local 'allout-bullets-string-len)
+;;;_ = allout-depth-specific-regexp
+(defvar allout-depth-specific-regexp ""
+ "*Regular expression to match a heading line prefix for a particular depth.
+
+This expression is used to search for depth-specific topic
+headers at depth 2 and greater. Use `allout-depth-one-regexp'
+for to seek topics at depth one.
+
+This var is set according to the user configuration vars by
+`set-allout-regexp'. It is prepared with format strings for two
+decimal numbers, which should each be one less than the depth of the
+topic prefix to be matched.")
+(make-variable-buffer-local 'allout-depth-specific-regexp)
+;;;_ = allout-depth-one-regexp
+(defvar allout-depth-one-regexp ""
+ "*Regular expression to match a heading line prefix for depth one.
+
+This var is set according to the user configuration vars by
+`set-allout-regexp'. It is prepared with format strings for two
+decimal numbers, which should each be one less than the depth of the
+topic prefix to be matched.")
+(make-variable-buffer-local 'allout-depth-one-regexp)
;;;_ = allout-line-boundary-regexp
(defvar allout-line-boundary-regexp ()
"`allout-regexp' with outline style beginning-of-line anchor.
-This is properly set when `allout-regexp' is produced by
-`set-allout-regexp', so that (match-beginning 2) and (match-end
-2) delimit the prefix.")
+This is properly set by `set-allout-regexp'.")
(make-variable-buffer-local 'allout-line-boundary-regexp)
;;;_ = allout-bob-regexp
(defvar allout-bob-regexp ()
- "Like `allout-line-boundary-regexp', for headers at beginning of buffer.
-\(match-beginning 2) and \(match-end 2) delimit the prefix.")
+ "Like `allout-line-boundary-regexp', for headers at beginning of buffer.")
(make-variable-buffer-local 'allout-bob-regexp)
;;;_ = allout-header-subtraction
(defvar allout-header-subtraction (1- (length allout-header-prefix))
"Length of `allout-plain-bullets-string', updated by `set-allout-regexp'.")
(make-variable-buffer-local 'allout-plain-bullets-string-len)
+;;;_ = allout-doublecheck-at-and-shallower
+(defconst allout-doublecheck-at-and-shallower 2
+ "Validate apparent topics of this depth and shallower as being non-aberrant.
+Verified with `allout-aberrant-container-p'. This check's usefulness is
+limited to shallow depths, because the determination of aberrance
+is according to the mistaken item being followed by a legitimate item of
+excessively greater depth.")
;;;_ X allout-reset-header-lead (header-lead)
(defun allout-reset-header-lead (header-lead)
"*Reset the leading string used to identify topic headers."
`allout-use-mode-specific-leader'
and `allout-mode-leaders'.
-Apply this via \(re)activation of `allout-mode', rather than
+Apply this via (re)activation of `allout-mode', rather than
invoking it directly."
(let* ((use-leader (and (boundp 'allout-use-mode-specific-leader)
(if (or (stringp allout-use-mode-specific-leader)
(defun allout-infer-body-reindent ()
"Determine proper setting for `allout-reindent-bodies'.
-Depends on default setting of `allout-reindent-bodies' \(which see)
+Depends on default setting of `allout-reindent-bodies' (which see)
and presence of setting for `comment-start', to tell whether the
file is programming code."
(if (and allout-reindent-bodies
"Generate proper topic-header regexp form for outline functions.
Works with respect to `allout-plain-bullets-string' and
-`allout-distinctive-bullets-string'."
+`allout-distinctive-bullets-string'.
+
+Also refresh various data structures that hinge on the regexp."
(interactive)
;; Derive allout-bullets-string from user configured components:
;; Derive next for repeated use in allout-pending-bullet:
(setq allout-plain-bullets-string-len (length allout-plain-bullets-string))
(setq allout-header-subtraction (1- (length allout-header-prefix)))
- ;; Produce the new allout-regexp:
- (setq allout-regexp (concat "\\("
- (regexp-quote allout-header-prefix)
- "[ \t]*["
- allout-bullets-string
- "]\\)\\|"
- (regexp-quote allout-primary-bullet)
- "+\\|\^l"))
- (setq allout-line-boundary-regexp
- (concat "\\(\n\\)\\(" allout-regexp "\\)"))
- (setq allout-bob-regexp
- (concat "\\(\\`\\)\\(" allout-regexp "\\)"))
- )
+
+ (let (new-part old-part)
+ (setq new-part (concat "\\("
+ (regexp-quote allout-header-prefix)
+ "[ \t]*"
+ ;; already regexp-quoted in a custom way:
+ "[" allout-bullets-string "]"
+ "\\)")
+ old-part (concat "\\("
+ (regexp-quote allout-primary-bullet)
+ "\\|"
+ (regexp-quote allout-header-prefix)
+ "\\)"
+ "+"
+ " ?[^" allout-primary-bullet "]")
+ allout-regexp (concat new-part
+ "\\|"
+ old-part
+ "\\|\^l")
+
+ allout-line-boundary-regexp (concat "\n" new-part
+ "\\|"
+ "\n" old-part)
+
+ allout-bob-regexp (concat "\\`" new-part
+ "\\|"
+ "\\`" old-part))
+
+ (setq allout-depth-specific-regexp
+ (concat "\\(^\\|\\`\\)"
+ "\\("
+
+ ;; new-style spacers-then-bullet string:
+ "\\("
+ (allout-format-quote (regexp-quote allout-header-prefix))
+ " \\{%s\\}"
+ "[" (allout-format-quote allout-bullets-string) "]"
+ "\\)"
+
+ ;; old-style all-bullets string, if primary not multi-char:
+ (if (< 0 allout-header-subtraction)
+ ""
+ (concat "\\|\\("
+ (allout-format-quote
+ (regexp-quote allout-primary-bullet))
+ (allout-format-quote
+ (regexp-quote allout-primary-bullet))
+ (allout-format-quote
+ (regexp-quote allout-primary-bullet))
+ "\\{%s\\}"
+ ;; disqualify greater depths:
+ "[^"
+ (allout-format-quote allout-primary-bullet)
+ "]\\)"
+ ))
+ "\\)"
+ ))
+ (setq allout-depth-one-regexp
+ (concat "\\(^\\|\\`\\)"
+ "\\("
+
+ "\\("
+ (regexp-quote allout-header-prefix)
+ ;; disqualify any bullet char following any amount of
+ ;; intervening whitespace:
+ " *"
+ (concat "[^ " allout-bullets-string "]")
+ "\\)"
+ (if (< 0 allout-header-subtraction)
+ ;; Need not support anything like the old
+ ;; bullet style if the prefix is multi-char.
+ ""
+ (concat "\\|"
+ (regexp-quote allout-primary-bullet)
+ ;; disqualify deeper primary-bullet sequences:
+ "[^" allout-primary-bullet "]"))
+ "\\)"
+ ))))
;;;_ : Key bindings
;;;_ = allout-mode-map
(defvar allout-mode-map nil "Keybindings for (allout) outline minor mode.")
;;;_ > produce-allout-mode-map (keymap-alist &optional base-map)
(defun produce-allout-mode-map (keymap-list &optional base-map)
- "Produce keymap for use as allout-mode-map, from KEYMAP-LIST.
+ "Produce keymap for use as `allout-mode-map', from KEYMAP-LIST.
Built on top of optional BASE-MAP, or empty sparse map if none specified.
-See doc string for allout-keybindings-list for format of binding list."
+See doc string for `allout-keybindings-list' for format of binding list."
(let ((map (or base-map (make-sparse-keymap)))
(pref (list allout-command-prefix)))
(mapcar (function
(if (not (symbolp name))
(error "Pair's name, %S, must be a symbol, not %s"
name (type-of name)))
- (setq prior-value (condition-case err
+ (setq prior-value (condition-case nil
(symbol-value name)
(void-variable nil)))
(when (not (assoc name allout-mode-prior-settings))
;;;_ > allout-unprotected (expr)
(defmacro allout-unprotected (expr)
"Enable internal outline operations to alter invisible text."
- `(let ((inhibit-read-only t)
+ `(let ((inhibit-read-only (if (not buffer-read-only) t))
(inhibit-field-text-motion t))
,expr))
;;;_ = allout-mode-hook
"Symbol for use as allout invisible-text overlay category.")
;;;_ x allout-view-change-hook
(defvar allout-view-change-hook nil
- "*\(Deprecated\) A hook run after allout outline exposure changes.
+ "*(Deprecated) A hook run after allout outline exposure changes.
Switch to using `allout-exposure-change-hook' instead. Both hooks are
currently respected, but the other conveys the details of the exposure
search attacks.
The verifier string is retained as an Emacs file variable, as well as in
-the emacs buffer state, if file variable adjustments are enabled. See
+the Emacs buffer state, if file variable adjustments are enabled. See
`allout-enable-file-variable-adjustment' for details about that.")
(make-variable-buffer-local 'allout-passphrase-verifier-string)
;;;###autoload
See the description of `allout-passphrase-hint-handling' for details about how
the reminder is deployed.
-The hint is retained as an Emacs file variable, as well as in the emacs buffer
+The hint is retained as an Emacs file variable, as well as in the Emacs buffer
state, if file variable adjustments are enabled. See
`allout-enable-file-variable-adjustment' for details about that.")
(make-variable-buffer-local 'allout-passphrase-hint-string)
(goto-char (cadr allout-after-save-decrypt))
(setq allout-after-save-decrypt nil))
)
+;;;_ = allout-inhibit-aberrance-doublecheck nil
+;; In some exceptional moments, disparate topic depths need to be allowed
+;; momentarily, eg when one topic is being yanked into another and they're
+;; about to be reconciled. let-binding allout-inhibit-aberrance-doublecheck
+;; prevents the aberrance doublecheck to allow, eg, the reconciliation
+;; processing to happen in the presence of such discrepancies. It should
+;; almost never be needed, however.
+(defvar allout-inhibit-aberrance-doublecheck nil
+ "Internal state, for momentarily inhibits aberrance doublecheck.
+
+This should only be momentarily let-bound non-nil, not set
+non-nil in a lasting way.")
;;;_ #2 Mode activation
;;;_ = allout-explicitly-deactivated
MODE is one of the following symbols:
- - nil \(or no argument) deactivate auto-activation/layout;
+ - 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
+ - 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
((eq mode 'ask)
(message
(concat "Outline mode auto-activation and "
- "-layout \(upon confirmation) enabled."))
+ "-layout (upon confirmation) enabled."))
'ask)
((message
"Outline mode auto-activation and -layout enabled.")
"Toggle minor mode for controlling exposure and editing of text outlines.
\\<allout-mode-map>
-Optional arg forces mode to re-initialize iff arg is positive num or
-symbol. Allout outline mode always runs as a minor mode.
+Optional prefix argument TOGGLE forces the mode to re-initialize
+if it is positive, otherwise it turns the mode off. 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
+accommodating syntax-sensitive text like programming languages. (For
an example, see the allout code itself, which is organized as an allout
outline.)
-In addition to outline navigation and exposure, allout includes:
+In addition to typical outline navigation and exposure, allout includes:
- - topic-oriented repositioning, promotion/demotion, cut, and paste
- - integral outline exposure-layout
+ - topic-oriented authoring, including keystroke-based topic creation,
+ repositioning, promotion/demotion, cut, and paste
- incremental search with dynamic exposure and reconcealment of hidden text
- - automatic topic-number maintenance
+ - adjustable format, so programming code can be developed in outline-structure
- easy topic encryption and decryption
- - \"Hot-spot\" operation, for single-keystroke maneuvering and
- exposure control. \(See the allout-mode docstring.)
+ - \"Hot-spot\" operation, for single-keystroke maneuvering and exposure control
+ - integral outline layout, for automatic initial exposure when visiting a file
+ - independent extensibility, using comprehensive exposure and authoring hooks
and many other features.
-Below is a description of the bindings, and then explanation of
+Below is a description of the key bindings, and then explanation of
special `allout-mode' features and terminology. See also the outline
menubar additions for quick reference to many of the features, and see
the docstring of the function `allout-init' for instructions on
priming your emacs session for automatic activation of `allout-mode'.
-
-The bindings are dictated by the `allout-keybindings-list' and
-`allout-command-prefix' variables.
-
- Navigation: Exposure Control:
- ---------- ----------------
-\\[allout-next-visible-heading] allout-next-visible-heading | \\[allout-hide-current-subtree] allout-hide-current-subtree
-\\[allout-previous-visible-heading] allout-previous-visible-heading | \\[allout-show-children] allout-show-children
-\\[allout-up-current-level] allout-up-current-level | \\[allout-show-current-subtree] allout-show-current-subtree
-\\[allout-forward-current-level] allout-forward-current-level | \\[allout-show-current-entry] allout-show-current-entry
-\\[allout-backward-current-level] allout-backward-current-level | \\[allout-show-all] allout-show-all
-\\[allout-end-of-entry] allout-end-of-entry
-\\[allout-beginning-of-current-entry] allout-beginning-of-current-entry, alternately, goes to hot-spot
-
- Topic Header Production:
- -----------------------
-\\[allout-open-sibtopic] allout-open-sibtopic Create a new sibling after current topic.
-\\[allout-open-subtopic] allout-open-subtopic ... an offspring of current topic.
-\\[allout-open-supertopic] allout-open-supertopic ... a sibling of the current topic's parent.
-
- Topic Level and Prefix Adjustment:
- ---------------------------------
-\\[allout-shift-in] allout-shift-in Shift current topic and all offspring deeper.
-\\[allout-shift-out] allout-shift-out ... less deep.
-\\[allout-rebullet-current-heading] allout-rebullet-current-heading Prompt for alternate bullet for
- current topic.
-\\[allout-rebullet-topic] allout-rebullet-topic Reconcile bullets of topic and its offspring
- - distinctive bullets are not changed, others
- alternated according to nesting depth.
-\\[allout-number-siblings] allout-number-siblings Number bullets of topic and siblings - the
- offspring are not affected. With repeat
- count, revoke numbering.
-
- Topic-oriented Killing and Yanking:
- ----------------------------------
-\\[allout-kill-topic] allout-kill-topic Kill current topic, including offspring.
-\\[allout-kill-line] allout-kill-line Like kill-line, but reconciles numbering, etc.
-\\[allout-yank] allout-yank Yank, adjusting depth of yanked topic to
- depth of heading if yanking into bare topic
- heading (ie, prefix sans text).
-\\[allout-yank-pop] allout-yank-pop Is to allout-yank as yank-pop is to yank
-
- Topic-oriented Encryption:
- -------------------------
-\\[allout-toggle-current-subtree-encryption] allout-toggle-current-subtree-encryption Encrypt/Decrypt topic content
-
- Misc commands:
- -------------
-M-x outlineify-sticky Activate outline mode for current buffer,
- and establish a default file-var setting
- for `allout-layout'.
-\\[allout-mark-topic] allout-mark-topic
-\\[allout-copy-exposed-to-buffer] allout-copy-exposed-to-buffer
- Duplicate outline, sans concealed text, to
- buffer with name derived from derived from that
- of current buffer - \"*BUFFERNAME exposed*\".
-\\[allout-flatten-exposed-to-buffer] allout-flatten-exposed-to-buffer
- Like above 'copy-exposed', but convert topic
- prefixes to section.subsection... numeric
- format.
-\\[eval-expression] (allout-init t) Setup Emacs session for outline mode
- auto-activation.
+The bindings are dictated by the customizable `allout-keybindings-list'
+variable. We recommend customizing `allout-command-prefix' to use just
+`\\C-c' as the command prefix, if the allout bindings don't conflict with
+any personal bindings you have on \\C-c. In any case, outline structure
+navigation and authoring is simplified by positioning the cursor on an
+item's bullet character, the \"hot-spot\" - then you can invoke allout
+commands with just the un-prefixed, un-control-shifted command letters.
+This is described further in the HOT-SPOT Operation section.
+
+ Exposure Control:
+ ----------------
+\\[allout-hide-current-subtree] `allout-hide-current-subtree'
+\\[allout-show-children] `allout-show-children'
+\\[allout-show-current-subtree] `allout-show-current-subtree'
+\\[allout-show-current-entry] `allout-show-current-entry'
+\\[allout-show-all] `allout-show-all'
+
+ Navigation:
+ ----------
+\\[allout-next-visible-heading] `allout-next-visible-heading'
+\\[allout-previous-visible-heading] `allout-previous-visible-heading'
+\\[allout-up-current-level] `allout-up-current-level'
+\\[allout-forward-current-level] `allout-forward-current-level'
+\\[allout-backward-current-level] `allout-backward-current-level'
+\\[allout-end-of-entry] `allout-end-of-entry'
+\\[allout-beginning-of-current-entry] `allout-beginning-of-current-entry' (alternately, goes to hot-spot)
+\\[allout-beginning-of-line] `allout-beginning-of-line' - like regular beginning-of-line, but
+ if immediately repeated cycles to the beginning of the current item
+ and then to the hot-spot (if `allout-beginning-of-line-cycles' is set).
+
+
+ Topic Header Production:
+ -----------------------
+\\[allout-open-sibtopic] `allout-open-sibtopic' Create a new sibling after current topic.
+\\[allout-open-subtopic] `allout-open-subtopic' ... an offspring of current topic.
+\\[allout-open-supertopic] `allout-open-supertopic' ... a sibling of the current topic's parent.
+
+ Topic Level and Prefix Adjustment:
+ ---------------------------------
+\\[allout-shift-in] `allout-shift-in' Shift current topic and all offspring deeper
+\\[allout-shift-out] `allout-shift-out' ... less deep
+\\[allout-rebullet-current-heading] `allout-rebullet-current-heading' Prompt for alternate bullet for
+ current topic
+\\[allout-rebullet-topic] `allout-rebullet-topic' Reconcile bullets of topic and
+ its' offspring - distinctive bullets are not changed, others
+ are alternated according to nesting depth.
+\\[allout-number-siblings] `allout-number-siblings' Number bullets of topic and siblings -
+ the offspring are not affected.
+ With repeat count, revoke numbering.
+
+ Topic-oriented Killing and Yanking:
+ ----------------------------------
+\\[allout-kill-topic] `allout-kill-topic' Kill current topic, including offspring.
+\\[allout-copy-topic-as-kill] `allout-copy-topic-as-kill' Copy current topic, including offspring.
+\\[allout-kill-line] `allout-kill-line' kill-line, attending to outline structure.
+\\[allout-copy-line-as-kill] `allout-copy-line-as-kill' Copy line but don't delete it.
+\\[allout-yank] `allout-yank' Yank, adjusting depth of yanked topic to
+ depth of heading if yanking into bare topic
+ heading (ie, prefix sans text).
+\\[allout-yank-pop] `allout-yank-pop' Is to allout-yank as yank-pop is to yank
+
+ Topic-oriented Encryption:
+ -------------------------
+\\[allout-toggle-current-subtree-encryption] `allout-toggle-current-subtree-encryption'
+ Encrypt/Decrypt topic content
+
+ Misc commands:
+ -------------
+M-x outlineify-sticky Activate outline mode for current buffer,
+ and establish a default file-var setting
+ for `allout-layout'.
+\\[allout-mark-topic] `allout-mark-topic'
+\\[allout-copy-exposed-to-buffer] `allout-copy-exposed-to-buffer'
+ Duplicate outline, sans concealed text, to
+ buffer with name derived from derived from that
+ of current buffer - \"*BUFFERNAME exposed*\".
+\\[allout-flatten-exposed-to-buffer] `allout-flatten-exposed-to-buffer'
+ Like above 'copy-exposed', but convert topic
+ prefixes to section.subsection... numeric
+ format.
+\\[eval-expression] (allout-init t) Setup Emacs session for outline mode
+ auto-activation.
Topic Encryption
symmetric and key-pair modes, passphrase timeout, passphrase
consistency checking, user-provided hinting for symmetric key
mode, and auto-encryption of topics pending encryption on save.
-\(Topics pending encryption are, by default, automatically
-encrypted during file saves; if you're editing the contents of
-such a topic, it is automatically decrypted for continued
-editing.) The aim is reliable topic privacy while preventing
-accidents like neglected encryption before saves, forgetting
-which passphrase was used, and other practical pitfalls.
-See `allout-toggle-current-subtree-encryption' function docstring and
-`allout-encrypt-unencrypted-on-saves' customization variable for details.
+Topics pending encryption are, by default, automatically
+encrypted during file saves. If the contents of the topic
+containing the cursor was encrypted for a save, it is
+automatically decrypted for continued editing.
+
+The aim of these measures is reliable topic privacy while
+preventing accidents like neglected encryption before saves,
+forgetting which passphrase was used, and other practical
+pitfalls.
+
+See `allout-toggle-current-subtree-encryption' function docstring
+and `allout-encrypt-unencrypted-on-saves' customization variable
+for details.
- HOT-SPOT Operation
+ HOT-SPOT Operation
Hot-spot operation provides a means for easy, single-keystroke outline
navigation and exposure control.
Thus, by positioning the cursor on a topic bullet, you can
execute the outline navigation and manipulation commands with a
-single keystroke. Regular navigation keys (eg, \\[forward-char], \\[next-line]) never get
+single keystroke. Regular navigation keys (eg, \\[forward-char], \\[next-line]) don't get
this special translation, so you can use them to get out of the
-hot-spot and back to normal operation.
+hot-spot and back to normal editing operation.
-Note that the command `allout-beginning-of-current-entry' \(\\[allout-beginning-of-current-entry]\)
-will move to the hot-spot when the cursor is already located at the
-beginning of the current entry, so you usually can hit \\[allout-beginning-of-current-entry]
-twice in a row to get to the hot-spot.
+In allout-mode, the normal beginning-of-line command (\\[allout-beginning-of-line]]) is
+replaced with one that makes it easy to get to the hot-spot. If you
+repeat it immediately it cycles (if `allout-beginning-of-line-cycles'
+is set) to the beginning of the item and then, if you hit it again
+immediately, to the hot-spot. Similarly, `allout-beginning-of-current-entry'
+\(\\[allout-beginning-of-current-entry]) moves to the hot-spot when the cursor is already located
+at the beginning of the current entry.
- Terminology
+ Extending Allout
+
+Allout exposure and authoring activites all have associated
+hooks, by which independent code can cooperate with allout
+without changes to the allout core. Here are key ones:
+
+`allout-mode-hook'
+`allout-mode-deactivate-hook'
+`allout-exposure-change-hook'
+`allout-structure-added-hook'
+`allout-structure-deleted-hook'
+`allout-structure-shifted-hook'
+
+ Terminology
Topic hierarchy constituents - TOPICS and SUBTOPICS:
-TOPIC: A basic, coherent component of an Emacs outline. It can
- contain and be contained by other topics.
-CURRENT topic:
- The visible topic most immediately containing the cursor.
-DEPTH: The degree of nesting of a topic; it increases with
- containment. Also called the:
-LEVEL: The same as DEPTH.
+ITEM: A unitary outline element, including the HEADER and ENTRY text.
+TOPIC: An ITEM and any ITEMs contained within it, ie having greater DEPTH
+ and with no intervening items of lower DEPTH than the container.
+CURRENT ITEM:
+ The visible ITEM most immediately containing the cursor.
+DEPTH: The degree of nesting of an ITEM; it increases with containment.
+ The DEPTH is determined by the HEADER PREFIX. The DEPTH is also
+ called the:
+LEVEL: The same as DEPTH.
ANCESTORS:
- The topics that contain a topic.
-PARENT: A topic's immediate ancestor. It has a depth one less than
- the topic.
+ Those ITEMs whose TOPICs contain an ITEM.
+PARENT: An ITEM's immediate ANCESTOR. It has a DEPTH one less than that
+ of the ITEM.
OFFSPRING:
- The topics contained by a topic;
+ The ITEMs contained within an ITEM's TOPIC.
SUBTOPIC:
- An immediate offspring of a topic;
-CHILDREN:
- The immediate offspring of a topic.
+ An OFFSPRING of its ANCESTOR TOPICs.
+CHILD:
+ An immediate SUBTOPIC of its PARENT.
SIBLINGS:
- Topics having the same parent and depth.
+ TOPICs having the same PARENT and DEPTH.
Topic text constituents:
-HEADER: The first line of a topic, include the topic PREFIX and header
- text.
-PREFIX: The leading text of a topic which distinguishes it from normal
- text. It has a strict form, which consists of a prefix-lead
- string, padding, and a bullet. The bullet may be followed by a
+HEADER: The first line of an ITEM, include the ITEM PREFIX and HEADER
+ text.
+ENTRY: The text content of an ITEM, before any OFFSPRING, but including
+ the HEADER text and distinct from the ITEM PREFIX.
+BODY: Same as ENTRY.
+PREFIX: The leading text of an ITEM which distinguishes it from normal
+ ENTRY text. Allout recognizes the outline structure according
+ to the strict PREFIX format. It consists of a PREFIX-LEAD string,
+ PREFIX-PADDING, and a BULLET. The BULLET might be followed by a
number, indicating the ordinal number of the topic among its
- siblings, a space, and then the header text.
+ siblings, or an asterisk indicating encryption, plus an optional
+ space. After that is the ITEM HEADER text, which is not part of
+ the PREFIX.
- The relative length of the PREFIX determines the nesting depth
- of the topic.
+ The relative length of the PREFIX determines the nesting DEPTH
+ of the ITEM.
PREFIX-LEAD:
- The string at the beginning of a topic prefix, normally a `.'.
- It can be customized by changing the setting of
- `allout-header-prefix' and then reinitializing `allout-mode'.
-
- By setting the prefix-lead to the comment-string of a
- programming language, you can embed outline structuring in
- program code without interfering with the language processing
- of that code. See `allout-use-mode-specific-leader'
- docstring for more detail.
+ The string at the beginning of a HEADER PREFIX, by default a `.'.
+ It can be customized by changing the setting of
+ `allout-header-prefix' and then reinitializing `allout-mode'.
+
+ When the PREFIX-LEAD is set to the comment-string of a
+ programming language, outline structuring can be embedded in
+ program code without interfering with processing of the text
+ (by emacs or the language processor) as program code. This
+ setting happens automatically when allout mode is used in
+ programming-mode buffers. See `allout-use-mode-specific-leader'
+ docstring for more detail.
PREFIX-PADDING:
- Spaces or asterisks which separate the prefix-lead and the
- bullet, determining the depth of the topic.
-BULLET: A character at the end of the topic prefix, it must be one of
- the characters listed on `allout-plain-bullets-string' or
- `allout-distinctive-bullets-string'. (See the documentation
- for these variables for more details.) The default choice of
- bullet when generating topics varies in a cycle with the depth of
- the topic.
-ENTRY: The text contained in a topic before any offspring.
-BODY: Same as ENTRY.
-
-
+ Spaces or asterisks which separate the PREFIX-LEAD and the
+ bullet, determining the ITEM's DEPTH.
+BULLET: A character at the end of the ITEM PREFIX, it must be one of
+ the characters listed on `allout-plain-bullets-string' or
+ `allout-distinctive-bullets-string'. When creating a TOPIC,
+ plain BULLETs are by default used, according to the DEPTH of the
+ TOPIC. Choice among the distinctive BULLETs is offered when you
+ provide a universal argugment \(\\[universal-argument]) to the
+ TOPIC creation command, or when explictly rebulleting a TOPIC. The
+ significance of the various distinctive bullets is purely by
+ convention. See the documentation for the above bullet strings for
+ more details.
EXPOSURE:
- The state of a topic which determines the on-screen visibility
- of its offspring and contained text.
+ The state of a TOPIC which determines the on-screen visibility
+ of its OFFSPRING and contained ENTRY text.
CONCEALED:
- Topics and entry text whose display is inhibited. Contiguous
- units of concealed text is represented by `...' ellipses.
+ TOPICs and ENTRY text whose EXPOSURE is inhibited. Concealed
+ text is represented by \"...\" ellipses.
- 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."
+ CONCEALED TOPICs are effectively collapsed within an ANCESTOR.
+CLOSED: A TOPIC whose immediate OFFSPRING and body-text is CONCEALED.
+OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be."
;;;_ . Code
(interactive "P")
(remove-from-invisibility-spec '(allout . t))
(remove-hook 'pre-command-hook 'allout-pre-command-business t)
(remove-hook 'post-command-hook 'allout-post-command-business t)
- (when (featurep 'xemacs)
- (remove-hook 'before-change-functions 'allout-before-change-handler t))
+ (remove-hook 'before-change-functions 'allout-before-change-handler t)
(remove-hook 'isearch-mode-end-hook 'allout-isearch-end-handler t)
(remove-hook write-file-hook-var-name 'allout-write-file-hook-handler t)
(remove-hook 'auto-save-hook 'allout-auto-save-hook-handler t)
(allout-overlay-preparations) ; Doesn't hurt to redo this.
- (allout-infer-header-lead)
+ (allout-infer-header-lead-and-primary-bullet)
(allout-infer-body-reindent)
(set-allout-regexp)
extend))
;; Produce map from current version of allout-keybindings-list:
- (setq allout-mode-map
- (produce-allout-mode-map allout-keybindings-list))
- (substitute-key-definition 'beginning-of-line
- 'allout-beginning-of-line
- allout-mode-map global-map)
- (substitute-key-definition 'move-beginning-of-line
- 'allout-beginning-of-line
- allout-mode-map global-map)
- (substitute-key-definition 'end-of-line
- 'allout-end-of-line
- allout-mode-map global-map)
- (substitute-key-definition 'move-end-of-line
- 'allout-end-of-line
- allout-mode-map global-map)
+ (allout-setup-mode-map)
(produce-allout-mode-menubar-entries)
- (fset 'allout-mode-map allout-mode-map)
;; Include on minor-mode-map-alist, if not already there:
(if (not (member '(allout-mode . allout-mode-map)
minor-mode-map-alist)))
(add-to-invisibility-spec '(allout . t))
+
(allout-add-resumptions '(line-move-ignore-invisible t))
(add-hook 'pre-command-hook 'allout-pre-command-business nil t)
(add-hook 'post-command-hook 'allout-post-command-business nil t)
- (when (featurep 'xemacs)
- (add-hook 'before-change-functions 'allout-before-change-handler
- nil t))
+ (add-hook 'before-change-functions 'allout-before-change-handler
+ nil t)
(add-hook 'isearch-mode-end-hook 'allout-isearch-end-handler nil t)
(add-hook write-file-hook-var-name 'allout-write-file-hook-handler
nil t)
allout-mode
) ; let*
) ; defun
+
+(defun allout-setup-mode-map ()
+ "Establish allout-mode bindings."
+ (setq-default allout-mode-map
+ (produce-allout-mode-map allout-keybindings-list))
+ (setq allout-mode-map
+ (produce-allout-mode-map allout-keybindings-list))
+ (substitute-key-definition 'beginning-of-line
+ 'allout-beginning-of-line
+ allout-mode-map global-map)
+ (substitute-key-definition 'move-beginning-of-line
+ 'allout-beginning-of-line
+ allout-mode-map global-map)
+ (substitute-key-definition 'end-of-line
+ 'allout-end-of-line
+ allout-mode-map global-map)
+ (substitute-key-definition 'move-end-of-line
+ 'allout-end-of-line
+ allout-mode-map global-map)
+ (fset 'allout-mode-map allout-mode-map))
+
+;; ensure that allout-mode-map has some setting even if allout-mode hasn't
+;; been invoked:
+(allout-setup-mode-map)
+
;;;_ > allout-minor-mode
(defalias 'allout-minor-mode 'allout-mode)
"Get confirmation before making arbitrary changes to invisible text.
We expose the invisible text and ask for confirmation. Refusal or
-keyboard-quit abandons the changes, with keyboard-quit additionally
+`keyboard-quit' abandons the changes, with keyboard-quit additionally
reclosing the opened text.
-No confirmation is necessary when inhibit-read-only is set - eg, allout
+No confirmation is necessary when `inhibit-read-only' is set - eg, allout
internal functions use this feature cohesively bunch changes."
(when (and (not inhibit-read-only) (not after))
(defun allout-before-change-handler (beg end)
"Protect against changes to invisible text.
-See allout-overlay-interior-modification-handler for details.
+See allout-overlay-interior-modification-handler for details."
+
+ (if (and (allout-mode-p) undo-in-progress (allout-hidden-p))
+ (allout-show-to-offshoot))
-This before-change handler is used only where modification-hooks
-overlay property is not supported."
;; allout-overlay-interior-modification-handler on an overlay handles
;; this in other emacs, via `allout-exposure-category's 'modification-hooks.
(when (and (featurep 'xemacs) (allout-mode-p))
;; process all of the pending overlays:
- (dolist (overlay (overlays-in beg end))
- (if (eq (overlay-get ol 'invisible) 'allout)
- (allout-overlay-interior-modification-handler
- overlay nil beg end nil)))))
+ (save-excursion
+ (goto-char beg)
+ (let ((overlay (allout-get-invisibility-overlay)))
+ (allout-overlay-interior-modification-handler
+ overlay nil beg end nil)))))
;;;_ > allout-isearch-end-handler (&optional overlay)
(defun allout-isearch-end-handler (&optional overlay)
"Reconcile allout outline exposure on arriving in hidden text after isearch.
(defvar allout-recent-prefix-end 0
"Buffer point of the end of the last topic prefix encountered.")
(make-variable-buffer-local 'allout-recent-prefix-end)
+;;;_ = allout-recent-depth
+(defvar allout-recent-depth 0
+ "Depth of the last topic prefix encountered.")
+(make-variable-buffer-local 'allout-recent-depth)
;;;_ = allout-recent-end-of-subtree
(defvar allout-recent-end-of-subtree 0
"Buffer point last returned by `allout-end-of-current-subtree'.")
(make-variable-buffer-local 'allout-recent-end-of-subtree)
-;;;_ > allout-prefix-data (beg end)
-(defmacro allout-prefix-data (beg end)
- "Register allout-prefix state data - BEGINNING and END of prefix.
-
-For reference by `allout-recent' funcs. Returns BEGINNING."
- `(setq allout-recent-prefix-end ,end
- allout-recent-prefix-beginning ,beg))
+;;;_ > allout-prefix-data ()
+(defsubst allout-prefix-data ()
+ "Register allout-prefix state data.
+
+For reference by `allout-recent' funcs. Return
+the new value of `allout-recent-prefix-beginning'."
+ (setq allout-recent-prefix-end (or (match-end 1) (match-end 2))
+ allout-recent-prefix-beginning (or (match-beginning 1)
+ (match-beginning 2))
+ allout-recent-depth (max 1 (- allout-recent-prefix-end
+ allout-recent-prefix-beginning
+ allout-header-subtraction)))
+ allout-recent-prefix-beginning)
+;;;_ > nullify-allout-prefix-data ()
+(defsubst nullify-allout-prefix-data ()
+ "Mark allout prefix data as being uninformative."
+ (setq allout-recent-prefix-end (point)
+ allout-recent-prefix-beginning (point)
+ allout-recent-depth 0)
+ allout-recent-prefix-beginning)
;;;_ > allout-recent-depth ()
-(defmacro allout-recent-depth ()
+(defsubst allout-recent-depth ()
"Return depth of last heading encountered by an outline maneuvering function.
All outline functions which directly do string matches to assess
`allout-recent-prefix-end' if successful. This function uses those settings
to return the current depth."
- '(max 1 (- allout-recent-prefix-end
- allout-recent-prefix-beginning
- allout-header-subtraction)))
+ allout-recent-depth)
;;;_ > allout-recent-prefix ()
-(defmacro allout-recent-prefix ()
+(defsubst allout-recent-prefix ()
"Like `allout-recent-depth', but returns text of last encountered prefix.
All outline functions which directly do string matches to assess
headings set the variables `allout-recent-prefix-beginning' and
`allout-recent-prefix-end' if successful. This function uses those settings
-to return the current depth."
- '(buffer-substring allout-recent-prefix-beginning
- allout-recent-prefix-end))
+to return the current prefix."
+ (buffer-substring-no-properties allout-recent-prefix-beginning
+ allout-recent-prefix-end))
;;;_ > allout-recent-bullet ()
(defmacro allout-recent-bullet ()
"Like allout-recent-prefix, but returns bullet of last encountered prefix.
headings set the variables `allout-recent-prefix-beginning' and
`allout-recent-prefix-end' if successful. This function uses those settings
to return the current depth of the most recently matched topic."
- '(buffer-substring (1- allout-recent-prefix-end)
- allout-recent-prefix-end))
+ '(buffer-substring-no-properties (1- allout-recent-prefix-end)
+ allout-recent-prefix-end))
;;;_ #4 Navigation
;;;_ - Position Assessment
;;;_ : Location Predicates
+;;;_ > allout-do-doublecheck ()
+(defsubst allout-do-doublecheck ()
+ "True if current item conditions qualify for checking on topic aberrance."
+ (and
+ ;; presume integrity of outline and yanked content during yank - necessary,
+ ;; to allow for level disparity of yank location and yanked text:
+ (not allout-inhibit-aberrance-doublecheck)
+ ;; allout-doublecheck-at-and-shallower is ceiling for doublecheck:
+ (<= allout-recent-depth allout-doublecheck-at-and-shallower)))
+;;;_ > allout-aberrant-container-p ()
+(defun allout-aberrant-container-p ()
+ "True if topic, or next sibling with children, contains them discontinuously.
+
+Discontinuous means an immediate offspring that is nested more
+than one level deeper than the topic.
+
+If topic has no offspring, then the next sibling with offspring will
+determine whether or not this one is determined to be aberrant.
+
+If true, then the allout-recent-* settings are calibrated on the
+offspring that qaulifies it as aberrant, ie with depth that
+exceeds the topic by more than one."
+
+ ;; This is most clearly understood when considering standard-prefix-leader
+ ;; low-level topics, which can all too easily match text not intended as
+ ;; headers. For example, any line with a leading '.' or '*' and lacking a
+ ;; following bullet qualifies without this protection. (A sequence of
+ ;; them can occur naturally, eg a typical textual bullet list.) We
+ ;; disqualify such low-level sequences when they are followed by a
+ ;; discontinuously contained child, inferring that the sequences are not
+ ;; actually connected with their prospective context.
+
+ (let ((depth (allout-depth))
+ (start-point (point))
+ done aberrant)
+ (save-excursion
+ (while (and (not done)
+ (re-search-forward allout-line-boundary-regexp nil 0))
+ (allout-prefix-data)
+ (goto-char allout-recent-prefix-beginning)
+ (cond
+ ;; sibling - continue:
+ ((eq allout-recent-depth depth))
+ ;; first offspring is excessive - aberrant:
+ ((> allout-recent-depth (1+ depth))
+ (setq done t aberrant t))
+ ;; next non-sibling is lower-depth - not aberrant:
+ (t (setq done t)))))
+ (if aberrant
+ aberrant
+ (goto-char start-point)
+ ;; recalibrate allout-recent-*
+ (allout-depth)
+ nil)))
;;;_ > allout-on-current-heading-p ()
(defun allout-on-current-heading-p ()
"Return non-nil if point is on current visible topics' header line.
(save-excursion
(allout-beginning-of-current-line)
(and (looking-at allout-regexp)
- (allout-prefix-data (match-beginning 0) (match-end 0)))))
+ (allout-prefix-data)
+ (or (not (allout-do-doublecheck))
+ (not (allout-aberrant-container-p))))))
;;;_ > allout-on-heading-p ()
(defalias 'allout-on-heading-p 'allout-on-current-heading-p)
;;;_ > allout-e-o-prefix-p ()
(let ((start-point (point)))
(if (and (allout-goto-prefix)
(not (< start-point (point))))
- (allout-recent-depth)
+ allout-recent-depth
(progn
- ;; Oops, no prefix, zero prefix data:
- (allout-prefix-data (point)(point))
+ ;; Oops, no prefix, nullify it:
+ (nullify-allout-prefix-data)
;; ... and return 0:
0)))))
;;;_ > allout-current-depth ()
(condition-case nil
(save-excursion
(allout-back-to-current-heading)
- (buffer-substring (- allout-recent-prefix-end 1)
- allout-recent-prefix-end))
+ (buffer-substring-no-properties (- allout-recent-prefix-end 1)
+ allout-recent-prefix-end))
;; Quick and dirty provision, ostensibly for missing bullet:
- ('args-out-of-range nil))
+ (args-out-of-range nil))
)
;;;_ > allout-get-prefix-bullet (prefix)
(defun allout-get-prefix-bullet (prefix)
;; Doesn't make sense if we're old-style prefixes, but this just
;; oughtn't be called then, so forget about it...
(if (string-match allout-regexp prefix)
- (substring prefix (1- (match-end 0)) (match-end 0))))
+ (substring prefix (1- (match-end 2)) (match-end 2))))
;;;_ > allout-sibling-index (&optional depth)
(defun allout-sibling-index (&optional depth)
"Item number of this prospective topic among its siblings.
(save-excursion
(cond ((and depth (<= depth 0) 0))
- ((or (not depth) (= depth (allout-depth)))
+ ((or (null depth) (= depth (allout-depth)))
(let ((index 1))
- (while (allout-previous-sibling (allout-recent-depth) nil)
+ (while (allout-previous-sibling allout-recent-depth nil)
(setq index (1+ index)))
index))
- ((< depth (allout-recent-depth))
+ ((< depth allout-recent-depth)
(allout-ascend-to-depth depth)
(allout-sibling-index))
(0))))
(if (or (not allout-beginning-of-line-cycles)
(not (equal last-command this-command)))
(move-beginning-of-line 1)
- (let ((beginning-of-body (save-excursion
- (allout-beginning-of-current-entry)
- (point))))
+ (allout-depth)
+ (let ((beginning-of-body
+ (save-excursion
+ (while (and (allout-do-doublecheck)
+ (allout-aberrant-container-p)
+ (allout-previous-visible-heading 1)))
+ (allout-beginning-of-current-entry)
+ (point))))
(cond ((= (current-column) 0)
- (allout-beginning-of-current-entry))
+ (goto-char beginning-of-body))
((< (point) beginning-of-body)
(allout-beginning-of-current-line))
((= (point) beginning-of-body)
(t (allout-beginning-of-current-line)
(if (< (point) beginning-of-body)
;; we were on the headline after its start:
- (allout-beginning-of-current-entry)))))))
+ (goto-char beginning-of-body)))))))
;;;_ > allout-end-of-line ()
(defun allout-end-of-line ()
"End-of-line with `allout-end-of-line-cycles' behavior, if set."
(allout-hidden-p)))
(allout-back-to-current-heading)
(allout-show-current-entry)
+ (allout-show-children)
(allout-end-of-entry))
((>= (point) end-of-entry)
(allout-back-to-current-heading)
(t (allout-end-of-entry))))))
;;;_ > allout-next-heading ()
(defsubst allout-next-heading ()
- "Move to the heading for the topic \(possibly invisible) after this one.
+ "Move to the heading for the topic (possibly invisible) after this one.
-Returns the location of the heading, or nil if none found."
+Returns the location of the heading, or nil if none found.
- (if (and (bobp) (not (eobp)) (looking-at allout-regexp))
+We skip anomalous low-level topics, a la `allout-aberrant-container-p'."
+ (if (looking-at allout-regexp)
(forward-char 1))
- (if (re-search-forward allout-line-boundary-regexp nil 0)
- (allout-prefix-data ; Got valid location state - set vars:
- (goto-char (or (match-beginning 2)
- allout-recent-prefix-beginning))
- (or (match-end 2) allout-recent-prefix-end))))
+ (when (re-search-forward allout-line-boundary-regexp nil 0)
+ (allout-prefix-data)
+ (and (allout-do-doublecheck)
+ ;; this will set allout-recent-* on the first non-aberrant topic,
+ ;; whether it's the current one or one that disqualifies it:
+ (allout-aberrant-container-p))
+ (goto-char allout-recent-prefix-beginning)))
;;;_ > allout-this-or-next-heading
(defun allout-this-or-next-heading ()
"Position cursor on current or next heading."
;; A throwaway non-macro that is defined after allout-next-heading
;; and usable by allout-mode.
- (if (not (allout-goto-prefix)) (allout-next-heading)))
+ (if (not (allout-goto-prefix-doublechecked)) (allout-next-heading)))
;;;_ > allout-previous-heading ()
-(defmacro allout-previous-heading ()
- "Move to the prior \(possibly invisible) heading line.
-
-Return the location of the beginning of the heading, or nil if not found."
-
- '(if (bobp)
- nil
- (allout-goto-prefix)
- (if
- ;; searches are unbounded and return nil if failed:
- (or (re-search-backward allout-line-boundary-regexp nil 0)
- (looking-at allout-bob-regexp))
- (progn ; Got valid location state - set vars:
- (allout-prefix-data
- (goto-char (or (match-beginning 2)
- allout-recent-prefix-beginning))
- (or (match-end 2) allout-recent-prefix-end))))))
+(defun allout-previous-heading ()
+ "Move to the prior (possibly invisible) heading line.
+
+Return the location of the beginning of the heading, or nil if not found.
+
+We skip anomalous low-level topics, a la `allout-aberrant-container-p'."
+
+ (if (bobp)
+ nil
+ (let ((start-point (point)))
+ ;; allout-goto-prefix-doublechecked calls us, so we can't use it here.
+ (allout-goto-prefix)
+ (when (or (re-search-backward allout-line-boundary-regexp nil 0)
+ (looking-at allout-bob-regexp))
+ (goto-char (allout-prefix-data))
+ (if (and (allout-do-doublecheck)
+ (allout-aberrant-container-p))
+ (or (allout-previous-heading)
+ (and (goto-char start-point)
+ ;; recalibrate allout-recent-*:
+ (allout-depth)
+ nil))
+ (point))))))
;;;_ > allout-get-invisibility-overlay ()
(defun allout-get-invisibility-overlay ()
"Return the overlay at point that dictates allout invisibility."
got)
(while (and overlays (not got))
(if (equal (overlay-get (car overlays) 'invisible) 'allout)
- (setq got (car overlays))))
+ (setq got (car overlays))
+ (pop overlays)))
got))
;;;_ > allout-back-to-visible-text ()
(defun allout-back-to-visible-text ()
;;;_ " These routines either produce or assess charts, which are
;;; nested lists of the locations of topics within a subtree.
;;;
-;;; Use of charts enables efficient navigation of subtrees, by
-;;; requiring only a single regexp-search based traversal, to scope
-;;; out the subtopic locations. The chart then serves as the basis
-;;; for assessment or adjustment of the subtree, without redundant
-;;; traversal of the structure.
+;;; Charts enable efficient subtree navigation by providing a reusable basis
+;;; for elaborate, compound assessment and adjustment of a subtree.
;;;_ > allout-chart-subtree (&optional levels visible orig-depth prev-depth)
(defun allout-chart-subtree (&optional levels visible 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.
+Optional argument LEVELS specifies a depth limit (relative to start
+depth) for the chart. Null LEVELS means no limit.
When optional argument VISIBLE is non-nil, the chart includes
only the visible subelements of the charted subjects.
-The remaining optional args are not for internal use by the function.
+The remaining optional args are for internal use by the function.
Point is left at the end of the subtree.
routines need assess the structure only once, and then use the chart
for their elaborate manipulations.
-Topics are entered in the chart so the last one is at the car.
-The entry for each topic consists of an integer indicating the point
-at the beginning of the topic. Charts for offspring consists of a
-list containing, recursively, the charts for the respective subtopics.
-The chart for a topics' offspring precedes the entry for the topic
-itself.
+The chart entries for the topics are in reverse order, so the
+last topic is listed first. The entry for each topic consists of
+an integer indicating the point at the beginning of the topic
+prefix. Charts for offspring consists of a list containing,
+recursively, the charts for the respective subtopics. The chart
+for a topics' offspring precedes the entry for the topic itself.
The other function parameters are for internal recursion, and should
not be specified by external callers. ORIG-DEPTH is depth of topic at
(while (and (not (eobp))
; Still within original topic?
- (< orig-depth (setq curr-depth (allout-recent-depth)))
+ (< orig-depth (setq curr-depth allout-recent-depth))
(cond ((= prev-depth curr-depth)
;; Register this one and move on:
- (setq chart (cons (point) chart))
+ (setq chart (cons allout-recent-prefix-beginning chart))
(if (and levels (<= levels 1))
;; At depth limit - skip sublevels:
(or (allout-next-sibling curr-depth)
;; or no more siblings - proceed to
;; next heading at lesser depth:
(while (and (<= curr-depth
- (allout-recent-depth))
+ allout-recent-depth)
(if visible
(allout-next-visible-heading 1)
(allout-next-heading)))))
Effectively a top-level chart of siblings. See `allout-chart-subtree'
for an explanation of charts."
(save-excursion
- (if (allout-goto-prefix)
- (let ((chart (list (point))))
- (while (allout-next-sibling)
- (setq chart (cons (point) chart)))
- (if chart (setq chart (nreverse chart)))))))
+ (when (allout-goto-prefix-doublechecked)
+ (let ((chart (list (point))))
+ (while (allout-next-sibling)
+ (setq chart (cons (point) chart)))
+ (if chart (setq chart (nreverse chart)))))))
;;;_ > allout-chart-to-reveal (chart depth)
(defun allout-chart-to-reveal (chart depth)
"Return a flat list of hidden points in subtree CHART, up to DEPTH.
+If DEPTH is nil, include hidden points at any depth.
+
Note that point can be left at any of the points on chart, or at the
start point."
(let (result here)
- (while (and (or (eq depth t) (> depth 0))
+ (while (and (or (null depth) (> depth 0))
chart)
(setq here (car chart))
(if (listp here)
- (let ((further (allout-chart-to-reveal here (or (eq depth t)
- (1- depth)))))
+ (let ((further (allout-chart-to-reveal here (if (null depth)
+ depth
+ (1- depth)))))
;; We're on the start of a subtree - recurse with it, if there's
;; more depth to go:
(if further (setq result (append further result)))
result))
;;;_ X allout-chart-spec (chart spec &optional exposing)
;; (defun allout-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.
;; - bare positive values indicate that this topic header should be
;; 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)
(search-backward "\n" nil 1))
(forward-char 1)
(if (looking-at allout-regexp)
- (setq done (allout-prefix-data (match-beginning 0)
- (match-end 0)))
+ (setq done (allout-prefix-data))
(forward-char -1)))
(if (bobp)
(cond ((looking-at allout-regexp)
- (allout-prefix-data (match-beginning 0)(match-end 0)))
+ (allout-prefix-data))
((allout-next-heading))
(done))
done)))
+;;;_ > allout-goto-prefix-doublechecked ()
+(defun allout-goto-prefix-doublechecked ()
+ "Put point at beginning of immediately containing outline topic.
+
+Like `allout-goto-prefix', but shallow topics (according to
+`allout-doublecheck-at-and-shallower') are checked and
+disqualified for child containment discontinuity, according to
+`allout-aberrant-container-p'."
+ (if (allout-goto-prefix)
+ (if (and (allout-do-doublecheck)
+ (allout-aberrant-container-p))
+ (allout-previous-heading)
+ (point))))
+
;;;_ > allout-end-of-prefix ()
(defun allout-end-of-prefix (&optional ignore-decorations)
"Position cursor at beginning of header text.
If optional IGNORE-DECORATIONS is non-nil, put just after bullet,
otherwise skip white space between bullet and ensuing text."
- (if (not (allout-goto-prefix))
+ (if (not (allout-goto-prefix-doublechecked))
nil
- (let ((match-data (match-data)))
- (goto-char (match-end 0))
- (if ignore-decorations
- t
- (while (looking-at "[0-9]") (forward-char 1))
- (if (and (not (eolp)) (looking-at "\\s-")) (forward-char 1)))
- (store-match-data match-data))
+ (goto-char allout-recent-prefix-end)
+ (if ignore-decorations
+ t
+ (while (looking-at "[0-9]") (forward-char 1))
+ (if (and (not (eolp)) (looking-at "\\s-")) (forward-char 1)))
;; Reestablish where we are:
(allout-current-depth)))
;;;_ > allout-current-bullet-pos ()
(defun allout-current-bullet-pos ()
- "Return position of current \(visible) topic's bullet."
+ "Return position of current (visible) topic's bullet."
- (if (not (allout-current-depth))
+ (if (not (allout-current-depth))
nil
- (1- (match-end 0))))
+ (1- allout-recent-prefix-end)))
;;;_ > allout-back-to-current-heading ()
(defun allout-back-to-current-heading ()
- "Move to heading line of current topic, or beginning if already on the line.
+ "Move to heading line of current topic, or beginning if not in a topic.
-Return value of point, unless we started outside of (before any) topics,
-in which case we return nil."
+If interactive, we position at the end of the prefix.
+
+Return value of resulting point, unless we started outside
+of (before any) topics, in which case we return nil."
(allout-beginning-of-current-line)
- (if (or (allout-on-current-heading-p)
- (and (re-search-backward (concat "^\\(" allout-regexp "\\)")
- nil 'move)
- (progn (while (allout-hidden-p)
- (allout-beginning-of-current-line)
- (if (not (looking-at allout-regexp))
- (re-search-backward (concat
- "^\\(" allout-regexp "\\)")
- nil 'move)))
- (allout-prefix-data (match-beginning 1)
- (match-end 1)))))
- (if (interactive-p)
- (allout-end-of-prefix)
- (point))))
+ (let ((bol-point (point)))
+ (if (allout-goto-prefix-doublechecked)
+ (if (<= (point) bol-point)
+ (if (interactive-p)
+ (allout-end-of-prefix)
+ (point))
+ (goto-char (point-min))
+ nil))))
;;;_ > allout-back-to-heading ()
(defalias 'allout-back-to-heading 'allout-back-to-current-heading)
;;;_ > allout-pre-next-prefix ()
Returns that character position."
- (if (re-search-forward allout-line-boundary-regexp nil 'move)
- (prog1 (goto-char (match-beginning 0))
- (allout-prefix-data (match-beginning 2)(match-end 2)))))
+ (if (allout-next-heading)
+ (goto-char (1- allout-recent-prefix-beginning))))
;;;_ > allout-end-of-subtree (&optional current include-trailing-blank)
(defun allout-end-of-subtree (&optional current include-trailing-blank)
"Put point at the end of the last leaf in the containing topic.
(interactive "P")
(if current
(allout-back-to-current-heading)
- (allout-goto-prefix))
- (let ((level (allout-recent-depth)))
+ (allout-goto-prefix-doublechecked))
+ (let ((level allout-recent-depth))
(allout-next-heading)
(while (and (not (eobp))
- (> (allout-recent-depth) level))
+ (> allout-recent-depth level))
(allout-next-heading))
(if (eobp)
(allout-end-of-entry)
(interactive)
(let ((start-point (point)))
(move-beginning-of-line 1)
+ (if (< 0 (allout-current-depth))
+ (goto-char allout-recent-prefix-end)
+ (goto-char (point-min)))
(allout-end-of-prefix)
(if (and (interactive-p)
(= (point) start-point))
(defun allout-ascend-to-depth (depth)
"Ascend to depth DEPTH, returning depth if successful, nil if not."
(if (and (> depth 0)(<= depth (allout-depth)))
- (let ((last-good (point)))
- (while (and (< depth (allout-depth))
- (setq last-good (point))
- (allout-beginning-of-level)
- (allout-previous-heading)))
- (if (= (allout-recent-depth) depth)
- (progn (goto-char allout-recent-prefix-beginning)
- depth)
- (goto-char last-good)
- nil))
- (if (interactive-p) (allout-end-of-prefix))))
+ (let (last-ascended)
+ (while (and (< depth allout-recent-depth)
+ (setq last-ascended (allout-ascend))))
+ (goto-char allout-recent-prefix-beginning)
+ (if (interactive-p) (allout-end-of-prefix))
+ (and last-ascended allout-recent-depth))))
;;;_ > allout-ascend ()
-(defun allout-ascend ()
- "Ascend one level, returning t if successful, nil if not."
+(defun allout-ascend (&optional dont-move-if-unsuccessful)
+ "Ascend one level, returning resulting depth if successful, nil if not.
+
+Point is left at the beginning of the level whether or not
+successful, unless optional DONT-MOVE-IF-UNSUCCESSFUL is set, in
+which case point is returned to its original starting location."
+ (if dont-move-if-unsuccessful
+ (setq dont-move-if-unsuccessful (point)))
(prog1
(if (allout-beginning-of-level)
- (allout-previous-heading))
+ (let ((bolevel (point))
+ (bolevel-depth allout-recent-depth))
+ (allout-previous-heading)
+ (cond ((< allout-recent-depth bolevel-depth)
+ allout-recent-depth)
+ ((= allout-recent-depth bolevel-depth)
+ (if dont-move-if-unsuccessful
+ (goto-char dont-move-if-unsuccessful))
+ (allout-depth)
+ nil)
+ (t
+ ;; some topic after very first is lower depth than first:
+ (goto-char bolevel)
+ (allout-depth)
+ nil))))
(if (interactive-p) (allout-end-of-prefix))))
;;;_ > allout-descend-to-depth (depth)
(defun allout-descend-to-depth (depth)
(start-depth (allout-depth)))
(while
(and (> (allout-depth) 0)
- (not (= depth (allout-recent-depth))) ; ... not there yet
+ (not (= depth allout-recent-depth)) ; ... not there yet
(allout-next-heading) ; ... go further
- (< start-depth (allout-recent-depth)))) ; ... still in topic
+ (< start-depth allout-recent-depth))) ; ... still in topic
(if (and (> (allout-depth) 0)
- (= (allout-recent-depth) depth))
+ (= allout-recent-depth depth))
depth
(goto-char start-point)
nil))
)
-;;;_ > allout-up-current-level (arg &optional dont-complain)
-(defun allout-up-current-level (arg &optional dont-complain)
- "Move out ARG levels from current visible topic.
-
-Positions on heading line of containing topic. Error if unable to
-ascend that far, or nil if unable to ascend but optional arg
-DONT-COMPLAIN is non-nil."
+;;;_ > allout-up-current-level (arg)
+(defun allout-up-current-level (arg)
+ "Move out ARG levels from current visible topic."
(interactive "p")
- (allout-back-to-current-heading)
- (let ((present-level (allout-recent-depth))
- (last-good (point))
- failed)
- ;; Loop for iterating arg:
- (while (and (> (allout-recent-depth) 1)
- (> arg 0)
- (not (bobp))
- (not failed))
- (setq last-good (point))
- ;; Loop for going back over current or greater depth:
- (while (and (not (< (allout-recent-depth) present-level))
- (or (allout-previous-visible-heading 1)
- (not (setq failed present-level)))))
- (setq present-level (allout-current-depth))
- (setq arg (- arg 1)))
- (if (or failed
- (> arg 0))
- (progn (goto-char last-good)
- (if (interactive-p) (allout-end-of-prefix))
- (if (not dont-complain)
- (error "Can't ascend past outermost level")
- (if (interactive-p) (allout-end-of-prefix))
- nil))
+ (let ((start-point (point)))
+ (allout-back-to-current-heading)
+ (if (not (allout-ascend))
+ (progn (goto-char start-point)
+ (error "Can't ascend past outermost level"))
(if (interactive-p) (allout-end-of-prefix))
allout-recent-prefix-beginning)))
Go backward if optional arg BACKWARD is non-nil.
-Return depth if successful, nil otherwise."
+Return the start point of the new topic if successful, nil otherwise."
- (if (and backward (bobp))
+ (if (if backward (bobp) (eobp))
nil
- (let ((start-depth (or depth (allout-depth)))
+ (let ((target-depth (or depth (allout-depth)))
(start-point (point))
+ (start-prefix-beginning allout-recent-prefix-beginning)
+ (count 0)
+ leaping
last-depth)
- (while (and (not (if backward (bobp) (eobp)))
- (if backward (allout-previous-heading)
- (allout-next-heading))
- (> (setq last-depth (allout-recent-depth)) start-depth)))
- (if (and (not (eobp))
- (and (> (or last-depth (allout-depth)) 0)
- (= (allout-recent-depth) start-depth)))
- allout-recent-prefix-beginning
- (goto-char start-point)
- (if depth (allout-depth) start-depth)
- nil))))
+ (while (and
+ ;; done too few single steps to resort to the leap routine:
+ (not leaping)
+ ;; not at limit:
+ (not (if backward (bobp) (eobp)))
+ ;; still traversable:
+ (if backward (allout-previous-heading) (allout-next-heading))
+ ;; we're below the target depth
+ (> (setq last-depth allout-recent-depth) target-depth))
+ (setq count (1+ count))
+ (if (> count 7) ; lists are commonly 7 +- 2, right?-)
+ (setq leaping t)))
+ (cond (leaping
+ (or (allout-next-sibling-leap target-depth backward)
+ (progn
+ (goto-char start-point)
+ (if depth (allout-depth) target-depth)
+ nil)))
+ ((and (not (eobp))
+ (and (> (or last-depth (allout-depth)) 0)
+ (= allout-recent-depth target-depth))
+ (not (= start-prefix-beginning
+ allout-recent-prefix-beginning)))
+ allout-recent-prefix-beginning)
+ (t
+ (goto-char start-point)
+ (if depth (allout-depth) target-depth)
+ nil)))))
+;;;_ > allout-next-sibling-leap (&optional depth backward)
+(defun allout-next-sibling-leap (&optional depth backward)
+ "Like `allout-next-sibling', but by direct search for topic at depth.
+
+Traverse at optional DEPTH, or current depth if none specified.
+
+Go backward if optional arg BACKWARD is non-nil.
+
+Return the start point of the new topic if successful, nil otherwise.
+
+Costs more than regular `allout-next-sibling' for short traversals:
+
+ - we have to check the prior (next, if travelling backwards)
+ item to confirm connectivity with the prior topic, and
+ - if confirmed, we have to reestablish the allout-recent-* settings with
+ some extra navigation
+ - if confirmation fails, we have to do more work to recover
+
+It is an increasingly big win when there are many intervening
+offspring before the next sibling, however, so
+`allout-next-sibling' resorts to this if it finds itself in that
+situation."
+
+ (if (if backward (bobp) (eobp))
+ nil
+ (let* ((start-point (point))
+ (target-depth (or depth (allout-depth)))
+ (search-whitespace-regexp nil)
+ (depth-biased (- target-depth 2))
+ (expression (if (<= target-depth 1)
+ allout-depth-one-regexp
+ (format allout-depth-specific-regexp
+ depth-biased depth-biased)))
+ found
+ done)
+ (while (not done)
+ (setq found (if backward
+ (re-search-backward expression nil 'to-limit)
+ (forward-char 1)
+ (re-search-forward expression nil 'to-limit)))
+ (if (and found (allout-aberrant-container-p))
+ (setq found nil))
+ (setq done (or found (if backward (bobp) (eobp)))))
+ (if (not found)
+ (progn (goto-char start-point)
+ nil)
+ ;; rationale: if any intervening items were at a lower depth, we
+ ;; would now be on the first offspring at the target depth - ie,
+ ;; the preceeding item (per the search direction) must be at a
+ ;; lesser depth. that's all we need to check.
+ (if backward (allout-next-heading) (allout-previous-heading))
+ (if (< allout-recent-depth target-depth)
+ ;; return to start and reestablish allout-recent-*:
+ (progn
+ (goto-char start-point)
+ (allout-depth)
+ nil)
+ (goto-char found)
+ ;; locate cursor and set allout-recent-*:
+ (allout-goto-prefix))))))
;;;_ > allout-previous-sibling (&optional depth backward)
(defun allout-previous-sibling (&optional depth backward)
"Like `allout-forward-current-level' backwards, respecting invisible topics.
(let ((depth (allout-depth)))
(while (allout-previous-sibling depth nil))
- (prog1 (allout-recent-depth)
+ (prog1 allout-recent-depth
(if (interactive-p) (allout-end-of-prefix)))))
;;;_ > allout-next-visible-heading (arg)
(defun allout-next-visible-heading (arg)
(step (if backward -1 1))
prev got)
- (while (> arg 0) ; limit condition
- (while (and (not (if backward (bobp)(eobp))) ; boundary condition
- ;; Move, skipping over all those concealed lines:
- (prog1 (condition-case nil (or (line-move step) t)
- (error nil))
- (allout-beginning-of-current-line))
- (not (setq got (looking-at allout-regexp)))))
+ (while (> arg 0)
+ (while (and
+ ;; Boundary condition:
+ (not (if backward (bobp)(eobp)))
+ ;; Move, skipping over all concealed lines in one fell swoop:
+ (prog1 (condition-case nil (or (line-move step) t)
+ (error nil))
+ (allout-beginning-of-current-line))
+ ;; Deal with apparent header line:
+ (if (not (looking-at allout-regexp))
+ ;; not a header line, keep looking:
+ t
+ (allout-prefix-data)
+ (if (and (allout-do-doublecheck)
+ (allout-aberrant-container-p))
+ ;; skip this aberrant prospective header line:
+ t
+ ;; this prospective headerline qualifies - register:
+ (setq got allout-recent-prefix-beginning)
+ ;; and break the loop:
+ nil))))
;; Register this got, it may be the last:
(if got (setq prev got))
(setq arg (1- arg)))
(cond (got ; Last move was to a prefix:
- (allout-prefix-data (match-beginning 0) (match-end 0))
- (allout-end-of-prefix))
+ (allout-end-of-prefix))
(prev ; Last move wasn't, but prev was:
- (allout-prefix-data (match-beginning 0) (match-end 0)))
+ (goto-char prev)
+ (allout-end-of-prefix))
((not backward) (end-of-line) nil))))
;;;_ > allout-previous-visible-heading (arg)
(defun allout-previous-visible-heading (arg)
A heading line is one that starts with a `*' (or that `allout-regexp'
matches)."
(interactive "p")
- (allout-next-visible-heading (- arg)))
+ (prog1 (allout-next-visible-heading (- arg))
+ (if (interactive-p) (allout-end-of-prefix))))
;;;_ > allout-forward-current-level (arg)
(defun allout-forward-current-level (arg)
"Position point at the next heading of the same level.
(interactive "p")
(let ((start-depth (allout-current-depth))
(start-arg arg)
- (backward (> 0 arg))
- last-depth
- (last-good (point))
- at-boundary)
+ (backward (> 0 arg)))
(if (= 0 start-depth)
(error "No siblings, not in a topic..."))
(if backward (setq arg (* -1 arg)))
- (while (not (or (zerop arg)
- at-boundary))
- (while (and (not (if backward (bobp) (eobp)))
- (if backward (allout-previous-visible-heading 1)
- (allout-next-visible-heading 1))
- (> (setq last-depth (allout-recent-depth)) start-depth)))
- (if (and last-depth (= last-depth start-depth)
- (not (if backward (bobp) (eobp))))
- (setq last-good (point)
- arg (1- arg))
- (setq at-boundary t)))
- (if (and (not (eobp))
- (= arg 0)
- (and (> (or last-depth (allout-depth)) 0)
- (= (allout-recent-depth) start-depth)))
- allout-recent-prefix-beginning
- (goto-char last-good)
- (if (not (interactive-p))
- nil
- (allout-end-of-prefix)
- (error "Hit %s level %d topic, traversed %d of %d requested"
- (if backward "first" "last")
- (allout-recent-depth)
- (- (abs start-arg) arg)
- (abs start-arg))))))
+ (allout-back-to-current-heading)
+ (while (and (not (zerop arg))
+ (if backward
+ (allout-previous-sibling)
+ (allout-next-sibling)))
+ (setq arg (1- arg)))
+ (if (not (interactive-p))
+ nil
+ (allout-end-of-prefix)
+ (if (not (zerop arg))
+ (error "Hit %s level %d topic, traversed %d of %d requested"
+ (if backward "first" "last")
+ allout-recent-depth
+ (- (abs start-arg) arg)
+ (abs start-arg))))))
;;;_ > allout-backward-current-level (arg)
(defun allout-backward-current-level (arg)
"Inverse of `allout-forward-current-level'."
the cursor which has moved as a result of such reinterpretation is
positioned on the bullet character of the destination topic.
-The upshot is that you can get easy, single \(ie, unmodified\) key
+The upshot is that you can get easy, single (ie, unmodified) key
outline maneuvering operations by positioning the cursor on the bullet
char. When in this mode you can use regular cursor-positioning
command/keystrokes to relocate the cursor off of a bullet character to
Returns the qualifying command, if any, else nil."
(interactive)
- (let* ((key-num (cond ((numberp last-command-char) last-command-char)
+ (let* ((key-string (if (numberp last-command-char)
+ (char-to-string last-command-char)))
+ (key-num (cond ((numberp last-command-char) last-command-char)
;; for XEmacs character type:
((and (fboundp 'characterp)
(apply 'characterp (list last-command-char)))
(apply 'char-to-int (list last-command-char)))
(t 0)))
- mapped-binding
- (on-bullet (eq (point) (allout-current-bullet-pos))))
+ mapped-binding)
(if (zerop key-num)
nil
- (if (and (<= 33 key-num)
- (setq mapped-binding
+ (if (and
+ ;; exclude control chars and escape:
+ (<= 33 key-num)
+ (setq mapped-binding
+ (or (and (assoc key-string allout-keybindings-list)
+ ;; translate literal membership on list:
+ (cadr (assoc key-string allout-keybindings-list)))
+ ;; translate as a keybinding:
(key-binding (concat allout-command-prefix
(char-to-string
- (if (and (<= 97 key-num) ; "a"
+ (if (and (<= 97 key-num) ; "a"
(>= 122 key-num)) ; "z"
(- key-num 96) key-num)))
- t)))
- ;; Qualified with the allout prefix - do hot-spot operation.
+ t))))
+ ;; Qualified as an allout command - do hot-spot operation.
(setq allout-post-goto-bullet t)
;; accept-defaults nil, or else we'll get allout-item-icon-key-handler.
(setq mapped-binding (key-binding (char-to-string key-num))))
(while (keymapp mapped-binding)
(setq mapped-binding
- (lookup-key mapped-binding (read-key-sequence-vector nil t))))
+ (lookup-key mapped-binding (vector (read-char)))))
(if mapped-binding
(setq this-command mapped-binding)))))
(setq choice (solicit-char-in-string
(format "Select bullet: %s ('%s' default): "
sans-escapes
- default-bullet)
+ (substring-no-properties default-bullet))
sans-escapes
t)))
(message "")
(allout-get-bullet)))))
;;;_ > allout-encrypted-type-prefix (&optional prefix)
(defun allout-encrypted-type-prefix (&optional prefix)
- "True if current header prefix bullet is for an encrypted entry \(body)."
+ "True if current header prefix bullet is for an encrypted entry (body)."
(and allout-topic-encryption-bullet
(string= allout-topic-encryption-bullet
(if prefix
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,
+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.
When adding an offspring, it will be added immediately after the parent if
the other offspring are exposed, or after the last child if the offspring
-are hidden. \(The intervening offspring will be exposed in the latter
+are hidden. (The intervening offspring will be exposed in the latter
case.)
If OFFER-RECENT-BULLET is true, offer to use the bullet of the prior sibling.
-Runs
-
Nuances:
- Creation of new topics is with respect to the visible topic
(allout-ascend-to-depth depth))
((>= relative-depth 1) nil)
(t (allout-back-to-current-heading)))
- (setq ref-depth (allout-recent-depth))
+ (setq ref-depth allout-recent-depth)
(setq ref-bullet
(if (> allout-recent-prefix-end 1)
(allout-recent-bullet)
(setq dbl-space t))
(if (save-excursion
(allout-next-heading)
- (when (> (allout-recent-depth) ref-depth)
+ (when (> allout-recent-depth ref-depth)
;; This is an offspring.
(forward-line -1)
(looking-at "^\\s-*$")))
(if (and dbl-space (not (> relative-depth 0)))
(newline 1))
(if (and (not (eobp))
- (not (bolp)))
+ (or (not (bolp))
+ (and (not (bobp))
+ ;; bolp doesnt detect concealed
+ ;; trailing newlines, compensate:
+ (save-excursion
+ (forward-char -1)
+ (allout-hidden-p)))))
(forward-char 1))))
))
(setq start (point))
(interactive "p")
(let ((initial-col (current-column))
(on-bullet (eq (point)(allout-current-bullet-pos)))
+ from to
(backwards (if (< arg 0)
(setq arg (* arg -1)))))
(while (> arg 0)
(save-excursion (allout-back-to-current-heading)
(allout-end-of-prefix)
+ (setq from allout-recent-prefix-beginning
+ to allout-recent-prefix-end)
(allout-rebullet-heading t ;;; solicit
nil ;;; depth
nil ;;; number-control
nil ;;; index
- t)) ;;; do-successors
+ t) ;;; do-successors
+ (run-hook-with-args 'allout-exposure-change-hook
+ from to t))
(setq arg (1- arg))
(if (<= arg 0)
nil
(setq initial-col nil) ; Override positioning back to init col
(if (not backwards)
(allout-next-visible-heading 1)
- (allout-goto-prefix)
+ (allout-goto-prefix-doublechecked)
(allout-next-visible-heading -1))))
(message "Done.")
(cond (on-bullet (goto-char (allout-current-bullet-pos)))
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
+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.
numbered form. It has effect only if `allout-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.
+of the fourth arg, INDEX.
-If NUMBER-CONTROL is non-nil and forth arg INDEX is nil, then the
+If NUMBER-CONTROL is non-nil and fourth arg INDEX is nil, then the
prefix of the topic is forced to be non-numbered. Null index and
non-nil NUMBER-CONTROL forces denumbering. Non-nil INDEX (and
non-nil NUMBER-CONTROL) forces a numbered-prefix form. If non-nil
(new-depth (or new-depth current-depth))
(mb allout-recent-prefix-beginning)
(me allout-recent-prefix-end)
- (current-bullet (buffer-substring (- me 1) me))
+ (current-bullet (buffer-substring-no-properties (- me 1) me))
+ (has-annotation (get-text-property mb 'allout-was-hidden))
(new-prefix (allout-make-topic-prefix current-bullet
nil
new-depth
(allout-unprotected
(delete-region (match-beginning 0)(match-end 0))))
+ ;; convey 'allout-was-hidden annotation, if original had it:
+ (if has-annotation
+ (put-text-property 0 (length new-prefix) 'allout-was-hidden t
+ new-prefix))
+
; Put in new prefix:
(allout-unprotected (insert new-prefix))
) ; let* ((current-depth (allout-depth))...)
) ; defun
;;;_ > allout-rebullet-topic (arg)
-(defun allout-rebullet-topic (arg)
+(defun allout-rebullet-topic (arg &optional sans-offspring)
"Rebullet the visible topic containing point and all contained subtopics.
Descends into invisible as well as visible topics, however.
+When optional SANS-OFFSPRING is non-nil, subtopics are not
+shifted. (Shifting a topic outwards without shifting its
+offspring is disallowed, since this would create a \"containment
+discontinuity\", where the depth difference between a topic and
+its immediate offspring is greater than one.)
+
With repeat count, shift topic depth by that amount."
(interactive "P")
(let ((start-col (current-column)))
;; Fill the user in, in case we're shifting a big topic:
(if (not (zerop arg)) (message "Shifting..."))
(allout-back-to-current-heading)
- (if (<= (+ (allout-recent-depth) arg) 0)
+ (if (<= (+ allout-recent-depth arg) 0)
(error "Attempt to shift topic below level 1"))
- (allout-rebullet-topic-grunt arg)
+ (allout-rebullet-topic-grunt arg nil nil nil nil sans-offspring)
(if (not (zerop arg)) (message "Shifting... done.")))
(move-to-column (max 0 (+ start-col arg)))))
-;;;_ > allout-rebullet-topic-grunt (&optional relative-depth ...)
+;;;_ > allout-rebullet-topic-grunt (&optional relative-depth ...)
(defun allout-rebullet-topic-grunt (&optional relative-depth
starting-depth
starting-point
index
- do-successors)
+ do-successors
+ sans-offspring)
"Like `allout-rebullet-topic', but on nearest containing topic
\(visible or not).
First arg RELATIVE-DEPTH means to shift the depth of the entire
topic that amount.
-The rest of the args are for internal recursive use by the function
-itself. The are STARTING-DEPTH, STARTING-POINT, and INDEX."
+Several subsequent args are for internal recursive use by the function
+itself: STARTING-DEPTH, STARTING-POINT, and INDEX.
+
+Finally, if optional SANS-OFFSPRING is non-nil then the offspring
+are not shifted. (Shifting a topic outwards without shifting
+its offspring is disallowed, since this would create a
+\"containment discontinuity\", where the depth difference between
+a topic and its immediate offspring is greater than one.)"
+
+ ;; XXX the recursion here is peculiar, and in general the routine may
+ ;; need simplification with refactoring.
+
+ (if (and sans-offspring
+ relative-depth
+ (< relative-depth 0))
+ (error (concat "Attempt to shift topic outwards without offspring,"
+ " would cause containment discontinuity.")))
(let* ((relative-depth (or relative-depth 0))
(new-depth (allout-depth))
(and (or (zerop relative-depth)
(not on-starting-call))
(allout-sibling-index))))
+ (starting-index index)
(moving-outwards (< 0 relative-depth))
- (starting-point (or starting-point (point))))
+ (starting-point (or starting-point (point)))
+ (local-point (point)))
;; Sanity check for excessive promotion done only on starting call:
(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:
- (allout-rebullet-heading nil ;;; solicit
- (+ starting-depth ;;; starting-depth
- relative-depth)
- nil ;;; number
- index ;;; index
- ;; Every contained topic will get hit,
- ;; and we have to get to outside ones
- ;; deliberately:
- nil) ;;; do-successors
- ;; ... and work on subsequent ones which are at greater depth:
- (setq index 0)
- (allout-next-heading)
- (while (and (not (eobp))
- (< starting-depth (allout-recent-depth)))
- (setq index (1+ index))
- (allout-rebullet-topic-grunt relative-depth ;;; relative-depth
- (1+ starting-depth);;;starting-depth
- starting-point ;;; starting-point
- index))) ;;; index
+ ;; We're at depth to work on this one.
+
+ ;; When shifting out we work on the children before working on
+ ;; the parent to avoid interim `allout-aberrant-container-p'
+ ;; aberrancy, and vice-versa when shifting in:
+ (if (>= relative-depth 0)
+ (allout-rebullet-heading nil
+ (+ starting-depth relative-depth)
+ nil ;;; number
+ index
+ nil)) ;;; do-successors
+ (when (not sans-offspring)
+ ;; ... and work on subsequent ones which are at greater depth:
+ (setq index 0)
+ (allout-next-heading)
+ (while (and (not (eobp))
+ (< starting-depth (allout-depth)))
+ (setq index (1+ index))
+ (allout-rebullet-topic-grunt relative-depth
+ (1+ starting-depth)
+ starting-point
+ index)))
+ (when (< relative-depth 0)
+ (save-excursion
+ (goto-char local-point)
+ (allout-rebullet-heading nil ;;; solicit
+ (+ starting-depth relative-depth)
+ nil ;;; number
+ starting-index
+ nil)))) ;;; do-successors
((< starting-depth new-depth)
;; Rare case - subtopic more than one level deeper than parent.
;; Treat this one at an even deeper level:
- (allout-rebullet-topic-grunt relative-depth ;;; relative-depth
- new-depth ;;; starting-depth
- starting-point ;;; starting-point
- index))) ;;; index
+ (allout-rebullet-topic-grunt relative-depth
+ new-depth
+ starting-point
+ index
+ sans-offspring)))
(if on-starting-call
(progn
;; if topic has changed depth
(if (or do-successors
(and (not (zerop relative-depth))
- (or (= (allout-recent-depth) starting-depth)
- (= (allout-recent-depth) (+ starting-depth
+ (or (= allout-recent-depth starting-depth)
+ (= allout-recent-depth (+ starting-depth
relative-depth)))))
(allout-rebullet-heading nil nil nil nil t))
;; Now rectify numbering of new siblings of the adjusted topic,
was-eobp)
(while (and (not (eobp))
(allout-depth)
- (>= (allout-recent-depth) depth)
+ (>= allout-recent-depth depth)
(>= ascender depth))
; Skip over all topics at
; lesser depths, which can not
; have been disturbed:
(while (and (not (setq was-eobp (eobp)))
- (> (allout-recent-depth) ascender))
+ (> allout-recent-depth ascender))
(allout-next-heading))
; Prime ascender for ascension:
- (setq ascender (1- (allout-recent-depth)))
- (if (>= (allout-recent-depth) depth)
+ (setq ascender (1- allout-recent-depth))
+ (if (>= allout-recent-depth depth)
(allout-rebullet-heading nil ;;; solicit
nil ;;; depth
nil ;;; number-control
nil ;;; index
t)) ;;; do-successors
(if was-eobp (goto-char (point-max)))))
- (allout-recent-depth))
+ allout-recent-depth)
;;;_ > allout-number-siblings (&optional denumber)
(defun allout-number-siblings (&optional denumber)
"Assign numbered topic prefix to this topic and its siblings.
(save-excursion
(allout-back-to-current-heading)
(allout-beginning-of-level)
- (let ((depth (allout-recent-depth))
+ (let ((depth allout-recent-depth)
(index (if (not denumber) 1))
(use-bullet (equal '(16) denumber))
(more t))
(setq more (allout-next-sibling depth nil))))))
;;;_ > allout-shift-in (arg)
(defun allout-shift-in (arg)
- "Increase depth of current heading and any topics collapsed within it.
+ "Increase depth of current heading and any items collapsed within it.
+
+With a negative argument, the item is shifted out using
+`allout-shift-out', instead.
+
+With an argument greater than one, shift-in the item but not its
+offspring, making the item into a sibling of its former children,
+and a child of sibling that formerly preceeded it.
+
+You are not allowed to shift the first offspring of a topic
+inwards, because that would yield a \"containment
+discontinuity\", where the depth difference between a topic and
+its immediate offspring is greater than one. The first topic in
+the file can be adjusted to any positive depth, however."
-We disallow shifts that would result in the topic having a depth more than
-one level greater than the immediately previous topic, to avoid containment
-discontinuity. The first topic in the file can be adjusted to any positive
-depth, however."
(interactive "p")
- (if (> arg 0)
- ;; refuse to create a containment discontinuity:
- (save-excursion
- (allout-back-to-current-heading)
- (if (not (bobp))
- (let* ((current-depth (allout-recent-depth))
- (start-point (point))
- (predecessor-depth (progn
- (forward-char -1)
- (allout-goto-prefix)
- (if (< (point) start-point)
- (allout-recent-depth)
- 0))))
- (if (and (> predecessor-depth 0)
- (> (+ current-depth arg)
- (1+ predecessor-depth)))
- (error (concat "Disallowed shift deeper than"
- " containing topic's children.")))))))
- (let ((where (point))
- has-successor)
- (if (and (< arg 0)
- (allout-current-topic-collapsed-p)
- (save-excursion (allout-next-sibling)))
- (setq has-successor t))
- (allout-rebullet-topic arg)
- (when (< arg 0)
- (save-excursion
- (if (allout-ascend)
- (allout-show-children)))
- (if has-successor
- (allout-show-children)))
- (run-hook-with-args 'allout-structure-shifted-hook arg where)))
+ (if (< arg 0)
+ (allout-shift-out (* arg -1))
+ ;; refuse to create a containment discontinuity:
+ (save-excursion
+ (allout-back-to-current-heading)
+ (if (not (bobp))
+ (let* ((current-depth allout-recent-depth)
+ (start-point (point))
+ (predecessor-depth (progn
+ (forward-char -1)
+ (allout-goto-prefix-doublechecked)
+ (if (< (point) start-point)
+ allout-recent-depth
+ 0))))
+ (if (and (> predecessor-depth 0)
+ (> (1+ current-depth)
+ (1+ predecessor-depth)))
+ (error (concat "Disallowed shift deeper than"
+ " containing topic's children."))
+ (allout-back-to-current-heading)
+ (if (< allout-recent-depth (1+ current-depth))
+ (allout-show-children))))))
+ (let ((where (point)))
+ (allout-rebullet-topic 1 (and (> arg 1) 'sans-offspring))
+ (run-hook-with-args 'allout-structure-shifted-hook arg where))))
;;;_ > allout-shift-out (arg)
(defun allout-shift-out (arg)
"Decrease depth of current heading and any topics collapsed within it.
+This will make the item a sibling of its former container.
+
+With a negative argument, the item is shifted in using
+`allout-shift-in', instead.
-We disallow shifts that would result in the topic having a depth more than
-one level greater than the immediately previous topic, to avoid containment
-discontinuity. The first topic in the file can be adjusted to any positive
-depth, however."
+With an argument greater than one, shift-out the item's offspring
+but not the item itself, making the former children siblings of
+the item.
+
+With an argument greater than 1, the item's offspring are shifted
+out without shifting the item. This will make the immediate
+subtopics into siblings of the item."
(interactive "p")
- (allout-shift-in (* arg -1)))
+ (if (< arg 0)
+ (allout-shift-in (* arg -1))
+ ;; Get proper exposure in this area:
+ (save-excursion (if (allout-ascend)
+ (allout-show-children)))
+ ;; Show collapsed children if there's a successor which will become
+ ;; their sibling:
+ (if (and (allout-current-topic-collapsed-p)
+ (save-excursion (allout-next-sibling)))
+ (allout-show-children))
+ (let ((where (and (allout-depth) allout-recent-prefix-beginning)))
+ (save-excursion
+ (if (> arg 1)
+ ;; Shift the offspring but not the topic:
+ (let ((children-chart (allout-chart-subtree 1)))
+ (if (listp (car children-chart))
+ ;; whoops:
+ (setq children-chart (allout-flatten children-chart)))
+ (save-excursion
+ (dolist (child-point children-chart)
+ (goto-char child-point)
+ (allout-shift-out 1))))
+ (allout-rebullet-topic (* arg -1))))
+ (run-hook-with-args 'allout-structure-shifted-hook (* arg -1) where))))
;;;_ : Surgery (kill-ring) functions with special provisions for outlines:
;;;_ > allout-kill-line (&optional arg)
(defun allout-kill-line (&optional arg)
(kill-line arg)
;; Ah, have to watch out for adjustments:
(let* ((beg (point))
+ end
(beg-hidden (allout-hidden-p))
(end-hidden (save-excursion (allout-end-of-current-line)
+ (setq end (point))
(allout-hidden-p)))
- (depth (allout-depth))
- (collapsed (allout-current-topic-collapsed-p)))
-
- (if collapsed
- (put-text-property beg (1+ beg) 'allout-was-collapsed t)
- (remove-text-properties beg (1+ beg) '(allout-was-collapsed t)))
+ (depth (allout-depth)))
+ (allout-annotate-hidden beg end)
(if (and (not beg-hidden) (not end-hidden))
(allout-unprotected (kill-line arg))
(kill-line arg))
- ; Provide some feedback:
- (sit-for 0)
+ (allout-deannotate-hidden beg end)
+
(if allout-numbered-bullet
(save-excursion ; Renumber subsequent topics if needed:
(if (not (looking-at allout-regexp))
(allout-next-heading))
(allout-renumber-to-depth depth)))
(run-hook-with-args 'allout-structure-deleted-hook depth (point)))))
+;;;_ > allout-copy-line-as-kill ()
+(defun allout-copy-line-as-kill ()
+ "Like allout-kill-topic, but save to kill ring instead of deleting."
+ (interactive)
+ (let ((buffer-read-only t))
+ (condition-case nil
+ (allout-kill-line)
+ (buffer-read-only nil))))
;;;_ > allout-kill-topic ()
(defun allout-kill-topic ()
"Kill topic together with subtopics.
- would not be added to whitespace already separating the topic from the
previous one.
-Completely collapsed topics are marked as such, for re-collapse
-when yank with allout-yank into an outline as a heading."
-
- ;; Some finagling is done to make complex topic kills appear faster
- ;; than they actually are. A redisplay is performed immediately
- ;; after the region is deleted, though the renumbering process
- ;; has yet to be performed. This means that there may appear to be
- ;; a lag *after* a kill has been performed.
+Topic exposure is marked with text-properties, to be used by
+`allout-yank-processing' for exposure recovery."
(interactive)
(let* ((inhibit-field-text-motion t)
- (collapsed (allout-current-topic-collapsed-p))
(beg (prog1 (allout-back-to-current-heading) (beginning-of-line)))
- (depth (allout-recent-depth)))
+ end
+ (depth allout-recent-depth))
(allout-end-of-current-subtree)
(if (and (/= (current-column) 0) (not (eobp)))
(forward-char 1))
(if (and (looking-at "\n")
(or (save-excursion
(or (not (allout-next-heading))
- (= depth (allout-recent-depth))))
+ (= depth allout-recent-depth)))
(and (> (- beg (point-min)) 3)
(string= (buffer-substring (- beg 2) beg) "\n\n"))))
(forward-char 1)))
- (if collapsed
- (allout-unprotected
- (put-text-property beg (1+ beg) 'allout-was-collapsed t))
- (allout-unprotected
- (remove-text-properties beg (1+ beg) '(allout-was-collapsed t))))
- (allout-unprotected (kill-region beg (point)))
- (sit-for 0)
+ (allout-annotate-hidden beg (setq end (point)))
+ (unwind-protect
+ (allout-unprotected (kill-region beg end))
+ (if buffer-read-only
+ ;; eg, during copy-as-kill.
+ (allout-deannotate-hidden beg end)))
+
(save-excursion
(allout-renumber-to-depth depth))
(run-hook-with-args 'allout-structure-deleted-hook depth (point))))
+;;;_ > allout-copy-topic-as-kill ()
+(defun allout-copy-topic-as-kill ()
+ "Like `allout-kill-topic', but save to kill ring instead of deleting."
+ (interactive)
+ (let ((buffer-read-only t))
+ (condition-case nil
+ (allout-kill-topic)
+ (buffer-read-only (message "Topic copied...")))))
+;;;_ > allout-annotate-hidden (begin end)
+(defun allout-annotate-hidden (begin end)
+ "Qualify text with properties to indicate exposure status."
+
+ (let ((was-modified (buffer-modified-p))
+ (buffer-read-only nil))
+ (allout-deannotate-hidden begin end)
+ (save-excursion
+ (goto-char begin)
+ (let (done next prev overlay)
+ (while (not done)
+ ;; at or advance to start of next hidden region:
+ (if (not (allout-hidden-p))
+ (setq next
+ (max (1+ (point))
+ (next-single-char-property-change (point)
+ 'invisible
+ nil end))))
+ (if (or (not next) (eq prev next))
+ ;; still not at start of hidden area - must not be any left.
+ (setq done t)
+ (goto-char next)
+ (setq prev next)
+ (if (not (allout-hidden-p))
+ ;; still not at start of hidden area.
+ (setq done t)
+ (setq overlay (allout-get-invisibility-overlay))
+ (setq next (overlay-end overlay)
+ prev next)
+ ;; advance to end of this hidden area:
+ (when next
+ (goto-char next)
+ (allout-unprotected
+ (let ((buffer-undo-list t))
+ (put-text-property (overlay-start overlay) next
+ 'allout-was-hidden t)))))))))
+ (set-buffer-modified-p was-modified)))
+;;;_ > allout-deannotate-hidden (begin end)
+(defun allout-deannotate-hidden (begin end)
+ "Remove allout hidden-text annotation between BEGIN and END."
+
+ (allout-unprotected
+ (let ((inhibit-read-only t)
+ (buffer-undo-list t))
+ ;(remove-text-properties begin end '(allout-was-hidden t))
+ )))
+;;;_ > allout-hide-by-annotation (begin end)
+(defun allout-hide-by-annotation (begin end)
+ "Translate text properties indicating exposure status into actual exposure."
+ (save-excursion
+ (goto-char begin)
+ (let ((was-modified (buffer-modified-p))
+ done next prev)
+ (while (not done)
+ ;; at or advance to start of next annotation:
+ (if (not (get-text-property (point) 'allout-was-hidden))
+ (setq next (next-single-char-property-change (point)
+ 'allout-was-hidden
+ nil end)))
+ (if (or (not next) (eq prev next))
+ ;; no more or not advancing - must not be any left.
+ (setq done t)
+ (goto-char next)
+ (setq prev next)
+ (if (not (get-text-property (point) 'allout-was-hidden))
+ ;; still not at start of annotation.
+ (setq done t)
+ ;; advance to just after end of this annotation:
+ (setq next (next-single-char-property-change (point)
+ 'allout-was-hidden
+ nil end))
+ (overlay-put (make-overlay prev next)
+ 'category 'allout-exposure-category)
+ (allout-deannotate-hidden prev next)
+ (setq prev next)
+ (if next (goto-char next)))))
+ (set-buffer-modified-p was-modified))))
;;;_ > allout-yank-processing ()
(defun allout-yank-processing (&optional arg)
; region around subject:
(if (< (allout-mark-marker t) (point))
(exchange-point-and-mark))
- (allout-unprotected
- (let* ((subj-beg (point))
- (into-bol (bolp))
- (subj-end (allout-mark-marker t))
- (was-collapsed (get-text-property subj-beg 'allout-was-collapsed))
- ;; 'resituate' if yanking an entire topic into topic header:
- (resituate (and (allout-e-o-prefix-p)
- (looking-at (concat "\\(" allout-regexp "\\)"))
- (allout-prefix-data (match-beginning 1)
- (match-end 1))))
- ;; `rectify-numbering' if resituating (where several topics may
- ;; be resituating) or yanking a topic into a topic slot (bol):
- (rectify-numbering (or resituate
- (and into-bol (looking-at allout-regexp)))))
- (if resituate
- ; The yanked stuff is a topic:
- (let* ((prefix-len (- (match-end 1) subj-beg))
- (subj-depth (allout-recent-depth))
- (prefix-bullet (allout-recent-bullet))
- (adjust-to-depth
- ;; Nil if adjustment unnecessary, otherwise depth to which
- ;; adjustment should be made:
- (save-excursion
- (and (goto-char subj-end)
- (eolp)
- (goto-char subj-beg)
- (and (looking-at allout-regexp)
- (progn
- (beginning-of-line)
- (not (= (point) subj-beg)))
- (looking-at allout-regexp)
- (allout-prefix-data (match-beginning 0)
- (match-end 0)))
- (allout-recent-depth))))
- (more t))
- (setq rectify-numbering allout-numbered-bullet)
- (if adjust-to-depth
+ (let* ((subj-beg (point))
+ (into-bol (bolp))
+ (subj-end (allout-mark-marker t))
+ ;; 'resituate' if yanking an entire topic into topic header:
+ (resituate (and (let ((allout-inhibit-aberrance-doublecheck t))
+ (allout-e-o-prefix-p))
+ (looking-at allout-regexp)
+ (allout-prefix-data)))
+ ;; `rectify-numbering' if resituating (where several topics may
+ ;; be resituating) or yanking a topic into a topic slot (bol):
+ (rectify-numbering (or resituate
+ (and into-bol (looking-at allout-regexp)))))
+ (if resituate
+ ;; Yanking a topic into the start of a topic - reconcile to fit:
+ (let* ((inhibit-field-text-motion t)
+ (prefix-len (if (not (match-end 1))
+ 1
+ (- (match-end 1) subj-beg)))
+ (subj-depth allout-recent-depth)
+ (prefix-bullet (allout-recent-bullet))
+ (adjust-to-depth
+ ;; Nil if adjustment unnecessary, otherwise depth to which
+ ;; adjustment should be made:
+ (save-excursion
+ (and (goto-char subj-end)
+ (eolp)
+ (goto-char subj-beg)
+ (and (looking-at allout-regexp)
+ (progn
+ (beginning-of-line)
+ (not (= (point) subj-beg)))
+ (looking-at allout-regexp)
+ (allout-prefix-data))
+ allout-recent-depth)))
+ (more t))
+ (setq rectify-numbering allout-numbered-bullet)
+ (if adjust-to-depth
; Do the adjustment:
- (progn
- (message "... yanking") (sit-for 0)
- (save-restriction
- (narrow-to-region subj-beg subj-end)
+ (progn
+ (save-restriction
+ (narrow-to-region subj-beg subj-end)
; Trim off excessive blank
; line at end, if any:
- (goto-char (point-max))
- (if (looking-at "^$")
- (allout-unprotected (delete-char -1)))
+ (goto-char (point-max))
+ (if (looking-at "^$")
+ (allout-unprotected (delete-char -1)))
; Work backwards, with each
; shallowest level,
; successively excluding the
; last processed topic from
; the narrow region:
- (while more
- (allout-back-to-current-heading)
+ (while more
+ (allout-back-to-current-heading)
; go as high as we can in each bunch:
- (while (allout-ascend-to-depth (1- (allout-depth))))
- (save-excursion
+ (while (allout-ascend t))
+ (save-excursion
+ (allout-unprotected
(allout-rebullet-topic-grunt (- adjust-to-depth
- subj-depth))
- (allout-depth))
- (if (setq more (not (bobp)))
- (progn (widen)
- (forward-char -1)
- (narrow-to-region subj-beg (point))))))
- (message "")
- ;; Preserve new bullet if it's a distinctive one, otherwise
- ;; use old one:
- (if (string-match (regexp-quote prefix-bullet)
- allout-distinctive-bullets-string)
+ subj-depth)))
+ (allout-depth))
+ (if (setq more (not (bobp)))
+ (progn (widen)
+ (forward-char -1)
+ (narrow-to-region subj-beg (point))))))
+ ;; Preserve new bullet if it's a distinctive one, otherwise
+ ;; use old one:
+ (if (string-match (regexp-quote prefix-bullet)
+ allout-distinctive-bullets-string)
; Delete from bullet of old to
; before bullet of new:
- (progn
- (beginning-of-line)
- (delete-region (point) subj-beg)
- (set-marker (allout-mark-marker t) subj-end)
- (goto-char subj-beg)
- (allout-end-of-prefix))
+ (progn
+ (beginning-of-line)
+ (allout-unprotected
+ (delete-region (point) subj-beg))
+ (set-marker (allout-mark-marker t) subj-end)
+ (goto-char subj-beg)
+ (allout-end-of-prefix))
; Delete base subj prefix,
; leaving old one:
- (delete-region (point) (+ (point)
- prefix-len
- (- adjust-to-depth subj-depth)))
+ (allout-unprotected
+ (progn
+ (delete-region (point) (+ (point)
+ prefix-len
+ (- adjust-to-depth
+ subj-depth)))
; and delete residual subj
; prefix digits and space:
- (while (looking-at "[0-9]") (delete-char 1))
- (if (looking-at " ") (delete-char 1))))
- (exchange-point-and-mark))))
- (if rectify-numbering
- (progn
- (save-excursion
+ (while (looking-at "[0-9]") (delete-char 1))
+ (if (looking-at " ") (delete-char 1))))))
+ (exchange-point-and-mark))))
+ (if rectify-numbering
+ (progn
+ (save-excursion
; Give some preliminary feedback:
- (message "... reconciling numbers") (sit-for 0)
+ (message "... reconciling numbers")
; ... and renumber, in case necessary:
- (goto-char subj-beg)
- (if (allout-goto-prefix)
+ (goto-char subj-beg)
+ (if (allout-goto-prefix-doublechecked)
+ (allout-unprotected
(allout-rebullet-heading nil ;;; solicit
- (allout-depth) ;;; depth
- nil ;;; number-control
- nil ;;; index
- t))
- (message ""))))
- (when (and (or into-bol resituate) was-collapsed)
- (remove-text-properties subj-beg (1+ subj-beg) '(allout-was-collapsed))
- (allout-hide-current-subtree))
- (if (not resituate)
- (exchange-point-and-mark))
- (run-hook-with-args 'allout-structure-added-hook subj-beg subj-end))))
+ (allout-depth) ;;; depth
+ nil ;;; number-control
+ nil ;;; index
+ t)))
+ (message ""))))
+ (if (or into-bol resituate)
+ (allout-hide-by-annotation (point) (allout-mark-marker t))
+ (allout-deannotate-hidden (allout-mark-marker t) (point)))
+ (if (not resituate)
+ (exchange-point-and-mark))
+ (run-hook-with-args 'allout-structure-added-hook subj-beg subj-end)))
;;;_ > allout-yank (&optional arg)
(defun allout-yank (&optional arg)
"`allout-mode' yank, with depth and numbering adjustment of yanked topics.
(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))
)
)
"Conceal text between FROM and TO if FLAG is non-nil, else reveal it.
Exposure-change hook `allout-exposure-change-hook' is run with the same
-arguments as this function, after the exposure changes are made. \(The old
+arguments as this function, after the exposure changes are made. (The old
`allout-view-change-hook' is being deprecated, and eventually will not be
-invoked.\)"
+invoked.)"
;; We use outline invisibility spec.
(remove-overlays from to 'category 'allout-exposure-category)
(interactive)
(save-excursion
(let (beg end)
- (allout-goto-prefix)
+ (allout-goto-prefix-doublechecked)
(setq beg (if (allout-hidden-p) (1- (point)) (point)))
(setq end (allout-pre-next-prefix))
(allout-flag-region beg end nil)
(save-excursion
(allout-beginning-of-current-line)
(save-restriction
- (let* ((chart (allout-chart-subtree (or level 1)))
- (to-reveal (allout-chart-to-reveal chart (or level 1))))
+ (let* (depth
+ ;; translate the level spec for this routine to the ones
+ ;; used by -chart-subtree and -chart-to-reveal:
+ (chart-level (cond ((not level) 1)
+ ((eq level t) nil)
+ (t level)))
+ (chart (allout-chart-subtree chart-level))
+ (to-reveal (or (allout-chart-to-reveal chart chart-level)
+ ;; interactive, show discontinuous children:
+ (and chart
+ (interactive-p)
+ (save-excursion
+ (allout-back-to-current-heading)
+ (setq depth (allout-current-depth))
+ (and (allout-next-heading)
+ (> allout-recent-depth
+ (1+ depth))))
+ (message
+ "Discontinuous offspring; use `%s %s'%s."
+ (substitute-command-keys
+ "\\[universal-argument]")
+ (substitute-command-keys
+ "\\[allout-shift-out]")
+ " to elevate them.")
+ (allout-chart-to-reveal
+ chart (- allout-recent-depth depth))))))
(goto-char start-point)
(when (and strict (allout-hidden-p))
;; Concealed root would already have been taken care of,
(save-excursion
(let ((inhibit-field-text-motion t)
(orig-pt (point))
- (orig-pref (allout-goto-prefix))
+ (orig-pref (allout-goto-prefix-doublechecked))
(last-at (point))
- bag-it)
- (while (or bag-it (allout-hidden-p))
+ (bag-it 0))
+ (while (or (> bag-it 1) (allout-hidden-p))
(while (allout-hidden-p)
- ;; XXX We would use `(move-beginning-of-line 1)', but it gets
- ;; stuck on hidden newlines at column 80, as of GNU Emacs 22.0.50.
- (beginning-of-line)
+ (move-beginning-of-line 1)
(if (allout-hidden-p) (forward-char -1)))
(if (= last-at (setq last-at (point)))
- ;; Oops, we're not making any progress! Show the current
- ;; topic completely, and bag this try.
+ ;; Oops, we're not making any progress! Show the current topic
+ ;; completely, and try one more time here, if we haven't already.
(progn (beginning-of-line)
(allout-show-current-subtree)
(goto-char orig-pt)
- (setq bag-it t)
- (beep)
- (message "%s: %s"
- "allout-show-to-offshoot: "
- "Aberrant nesting encountered.")))
- (allout-show-children)
- (goto-char orig-pref))
+ (setq bag-it (1+ bag-it))
+ (if (> bag-it 1)
+ (error "allout-show-to-offshoot: %s"
+ "Stumped by aberrant nesting.")))
+ (if (> bag-it 0) (setq bag-it 0))
+ (allout-show-children)
+ (goto-char orig-pref)))
(goto-char orig-pt)))
(if (allout-hidden-p)
(allout-show-entry)))
)))
;;;_ > allout-show-current-subtree (&optional arg)
(defun allout-show-current-subtree (&optional arg)
- "Show everything within the current topic. With a repeat-count,
-expose this topic and its siblings."
+ "Show everything within the current topic.
+With a repeat-count, expose this topic and its siblings."
(interactive "P")
(save-excursion
(if (<= (allout-current-depth) 0)
(current-exposed (not (allout-current-topic-collapsed-p t))))
(cond (current-exposed (allout-flag-current-subtree t))
(just-close nil)
- ((allout-up-current-level 1 t) (allout-hide-current-subtree))
+ ((allout-ascend) (allout-hide-current-subtree))
(t (goto-char 0)
(message sibs-msg)
- (allout-goto-prefix)
+ (allout-goto-prefix-doublechecked)
(allout-expose-topic '(0 :))
(message (concat sibs-msg " Done."))))
(goto-char from)))
Successive specs on a list are applied to successive sibling topics.
-A simple spec \(either a number, one of a few symbols, or the null
+A simple spec (either a number, one of a few symbols, or the null
list) dictates the exposure for the corresponding topic.
Non-null lists recursively designate exposure specs for respective
apply prior element to all siblings at current level, *up to*
those siblings that would be covered by specs following the `:'
on the list. Ie, apply to all topics at level but the last
- ones. \(Only first of multiple colons at same level is
+ ones. (Only first of multiple colons at same level is
respected - subsequent ones are discarded.)
* - completely opens the topic, including bodies.
+ - shows all the sub headers, but not the bodies
(cond ((eq curr-elem '*) (allout-show-current-subtree)
(if (> allout-recent-end-of-subtree max-pos)
(setq max-pos allout-recent-end-of-subtree)))
- ((eq curr-elem '+) (allout-show-current-branches)
+ ((eq curr-elem '+)
+ (if (not (allout-hidden-p))
+ (save-excursion (allout-hide-current-subtree t)))
+ (allout-show-current-branches)
(if (> allout-recent-end-of-subtree max-pos)
(setq max-pos allout-recent-end-of-subtree)))
((eq curr-elem '-) (allout-show-current-entry))
;;;_ > allout-old-expose-topic (spec &rest followers)
(defun allout-old-expose-topic (spec &rest followers)
- "Deprecated. Use `allout-expose-topic' \(with different schema
+ "Deprecated. Use `allout-expose-topic' (with different schema
format) instead.
Dictate wholesale exposure scheme for current topic, according to SPEC.
level, and expose children of subsequent topics at current
level *except* for the last, which should be opened completely."
(list 'save-excursion
- '(if (not (or (allout-goto-prefix)
+ '(if (not (or (allout-goto-prefix-doublechecked)
(allout-next-heading)))
(error "allout-new-exposure: Can't find any outline topics"))
(list 'allout-expose-topic (list 'quote spec))))
Optional START and END indicate bounds of region.
-optional arg, FORMAT, designates an alternate presentation form for
+Optional arg, FORMAT, designates an alternate presentation form for
the prefix:
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,
+ `indent' (symbol) - Convert header prefixes to all white space,
except for distinctive bullets.
The elements of the list produced are lists that represents a topic
(goto-char start)
(beginning-of-line)
;; Goto initial topic, and register preceeding stuff, if any:
- (if (> (allout-goto-prefix) start)
+ (if (> (allout-goto-prefix-doublechecked) 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 (allout-recent-depth) ; Current topics depth,
+ (setq depth allout-recent-depth ; Current topics depth,
bullet (allout-recent-bullet) ; ... bullet,
prefix (allout-recent-prefix)
beg (progn (allout-end-of-prefix t) (point))) ; and beginning.
(setq done ; The boundary for the current topic:
(not (allout-next-visible-heading 1)))
- (setq new-depth (allout-recent-depth))
+ (setq new-depth allout-recent-depth)
(setq gone-out out
out (< new-depth depth))
(beginning-of-line)
(allout-back-to-visible-text)))
strings))
(when (< (point) next) ; Resume from after hid text, if any.
- (line-move 1))
+ (line-move 1)
+ (beginning-of-line))
(setq beg (point)))
;; Accumulate list for this topic:
(setq strings (nreverse strings))
alternate presentation form:
`flat' - Present prefix as numeric section.subsection..., starting with
- section indicated by the start-num, innermost nesting first.
+ 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,
+ `indent' (symbol) - Convert header prefixes to all white space,
except for distinctive bullets.
Defaults:
;;;_ > allout-latex-verb-quote (string &optional flow)
(defun allout-latex-verb-quote (string &optional flow)
"Return copy of STRING for literal reproduction across LaTeX processing.
-Expresses the original characters \(including carriage returns) of the
+Expresses the original characters (including carriage returns) of the
string across LaTeX processing."
(mapconcat (function
(lambda (char)
""))
;;;_ > allout-latex-verbatim-quote-curr-line ()
(defun allout-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)
+Adjust line contents so it is unaltered (from the original line)
across LaTeX processing, within the context of a `verbatim'
environment. Leaves point at the end of the line."
(let ((inhibit-field-text-motion t))
;;"\\\\\\|\\{\\|\\}\\|\\_\\|\\$\\|\\\"\\|\\&\\|\\^\\|\\-\\|\\*\\|#"
end ; bounded by end-of-line
1) ; no matches, move to end & return nil
- (goto-char (match-beginning 0))
+ (goto-char (match-beginning 2))
(insert "\\")
(setq end (1+ end))
- (goto-char (1+ (match-end 0)))))))
+ (goto-char (1+ (match-end 2)))))))
;;;_ > allout-insert-latex-header (buffer)
(defun allout-insert-latex-header (buffer)
"Insert initial LaTeX commands at point in BUFFER."
(allout-latex-verb-quote (if allout-title
(condition-case nil
(eval allout-title)
- ('error "<unnamed buffer>"))
+ (error "<unnamed buffer>"))
"Unnamed Outline"))
"}\n"
"\\end{center}\n\n"))
"Encrypt clear or decrypt encoded text of visibly-containing topic's contents.
Optional FETCH-PASS universal argument provokes key-pair encryption with
-single universal argument. With doubled universal argument \(value = 16),
+single universal argument. With doubled universal argument (value = 16),
it forces prompting for the passphrase regardless of availability from the
passphrase cache. With no universal argument, the appropriate passphrase
is obtained from the cache, if available, else from the user.
-Currently only GnuPG encryption is supported.
+Only GnuPG encryption is supported.
-\**NOTE WELL** that the encrypted text must be ascii-armored. For gnupg
+\*NOTE WELL* that the encrypted text must be ascii-armored. For gnupg
encryption, include the option ``armor'' in your ~/.gnupg/gpg.conf file.
Both symmetric-key and key-pair encryption is implemented. Symmetric is
-the default, use a single \(x4) universal argument for keypair mode.
+the default, use a single (x4) universal argument for keypair mode.
Encrypted topic's bullet is set to a `~' to signal that the contents of the
-topic \(body and subtopics, but not heading) is pending encryption or
+topic (body and subtopics, but not heading) is pending encryption or
encrypted. `*' asterisk immediately after the bullet signals that the body
is encrypted, its' absence means the topic is meant to be encrypted but is
not. When a file with topics pending encryption is saved, topics pending
encryption are encrypted. See allout-encrypt-unencrypted-on-saves for
auto-encryption specifics.
-\**NOTE WELL** that automatic encryption that happens during saves will
-default to symmetric encryption - you must manually \(re)encrypt key-pair
+\*NOTE WELL* that automatic encryption that happens during saves will
+default to symmetric encryption - you must deliberately (re)encrypt key-pair
encrypted topics if you want them to continue to use the key-pair cipher.
-Level-1 topics, with prefix consisting solely of an `*' asterisk, cannot be
+Level-one topics, with prefix consisting solely of an `*' asterisk, cannot be
encrypted. If you want to encrypt the contents of a top-level topic, use
\\[allout-shift-in] to increase its depth.
The encryption passphrase is solicited if not currently available in the
passphrase cache from a recent encryption action.
-The solicited passphrase is retained for reuse in a buffer-specific cache
-for some set period of time \(default, 60 seconds), after which the string
-is nulled. The passphrase cache timeout is customized by setting
-`pgg-passphrase-cache-expiry'.
+The solicited passphrase is retained for reuse in a cache, if enabled. See
+`pgg-cache-passphrase' and `pgg-passphrase-cache-expiry' for details.
Symmetric Passphrase Hinting and Verification
non-nil, an entry for `allout-passphrase-verifier-string' and its value is
added to an Emacs 'local variables' section at the end of the file, which
is created if necessary. That setting is for retention of the passphrase
-verifier across emacs sessions.
+verifier across Emacs sessions.
Similarly, `allout-passphrase-hint-string' stores a user-provided reminder
about their passphrase, and `allout-passphrase-hint-handling' specifies
when the hint is presented, or if passphrase hints are disabled. If
-enabled \(see the `allout-passphrase-hint-handling' docstring for details),
+enabled (see the `allout-passphrase-hint-handling' docstring for details),
the hint string is stored in the local-variables section of the file, and
solicited whenever the passphrase is changed."
(interactive "P")
)
;;;_ > allout-toggle-subtree-encryption (&optional fetch-pass)
(defun allout-toggle-subtree-encryption (&optional fetch-pass)
- "Encrypt clear text or decrypt encoded topic contents \(body and subtopics.)
+ "Encrypt clear text or decrypt encoded topic contents (body and subtopics.)
Optional FETCH-PASS universal argument provokes key-pair encryption with
-single universal argument. With doubled universal argument \(value = 16),
+single universal argument. With doubled universal argument (value = 16),
it forces prompting for the passphrase regardless of availability from the
passphrase cache. With no universal argument, the appropriate passphrase
is obtained from the cache, if available, else from the user.
-Currently only GnuPG encryption is supported.
+Currently only GnuPG encryption is supported, and integration
+with gpg-agent is not yet implemented.
\**NOTE WELL** that the encrypted text must be ascii-armored. For gnupg
encryption, include the option ``armor'' in your ~/.gnupg/gpg.conf file.
(save-excursion
(allout-end-of-prefix t)
- (if (= (allout-recent-depth) 1)
+ (if (= allout-recent-depth 1)
(error (concat "Cannot encrypt or decrypt level 1 topics -"
" shift it in to make it encryptable")))
(let* ((allout-buffer (current-buffer))
- ;; Asses location:
+ ;; Assess location:
+ (bullet-pos allout-recent-prefix-beginning)
(after-bullet-pos (point))
(was-encrypted
(progn (if (= (point-max) after-bullet-pos)
'(symmetric nil)))
(for-key-type (car key-info))
(for-key-identity (cadr key-info))
- (fetch-pass (and fetch-pass (member fetch-pass '(16 (16))))))
+ (fetch-pass (and fetch-pass (member fetch-pass '(16 (16)))))
+ (was-coding-system buffer-file-coding-system))
+
+ (when (not was-encrypted)
+ ;; ensure that non-ascii chars pending encryption are noticed before
+ ;; they're encrypted, so the coding system is set to accomodate
+ ;; them.
+ (setq buffer-file-coding-system
+ (select-safe-coding-system subtree-beg subtree-end))
+ ;; if the coding system for the text being encrypted is different
+ ;; than that prevailing, then there a real risk that the coding
+ ;; system can't be noticed by emacs when the file is visited. to
+ ;; mitigate that, offer to preserve the coding system using a file
+ ;; local variable.
+ (if (and (not (equal buffer-file-coding-system
+ was-coding-system))
+ (yes-or-no-p
+ (format (concat "Register coding system %s as file local"
+ " var? Necessary when only encrypted text"
+ " is in that coding system. ")
+ buffer-file-coding-system)))
+ (allout-adjust-file-variable "buffer-file-coding-system"
+ buffer-file-coding-system)))
(setq result-text
(allout-encrypt-string subject-text was-encrypted
(delete-char 1))
;; Add the is-encrypted bullet qualifier:
(goto-char after-bullet-pos)
- (insert "*"))
- )
- )
- )
- )
- )
+ (insert "*"))))
+ (run-hook-with-args 'allout-structure-added-hook
+ bullet-pos subtree-end))))
;;;_ > allout-encrypt-string (text decrypt allout-buffer key-type for-key
;;; fetch-pass &optional retried verifying
;;; passphrase)
target-prompt-id
(or (buffer-file-name allout-buffer)
target-prompt-id))))
+ (encoding (with-current-buffer allout-buffer
+ buffer-file-coding-system))
+ (multibyte (with-current-buffer allout-buffer
+ enable-multibyte-characters))
(strip-plaintext-regexps
(if (not decrypt)
(allout-get-configvar-values
(rejected (or rejected 0))
(rejections-left (- allout-encryption-ciphertext-rejection-ceiling
rejected))
- result-text status)
+ result-text status
+ )
(if (and fetch-pass (not passphrase))
;; Force later fetch by evicting passphrase from the cache.
(catch 'encryption-failed
- ;; Obtain the passphrase if we don't already have one and we're not
- ;; doing a keypair encryption:
- (if (not (or passphrase
- (and (equal key-type 'keypair)
- (not decrypt))))
-
+ ;; We handle only symmetric-key passphrase caching.
+ (if (and (not passphrase)
+ (not (equal key-type 'keypair)))
(setq passphrase (allout-obtain-passphrase for-key
target-cache-id
target-prompt-id
(insert text)
+ ;; convey the text characteristics of the original buffer:
+ (set-buffer-multibyte multibyte)
+ (when encoding
+ (set-buffer-file-coding-system encoding)
+ (if (not decrypt)
+ (encode-coding-region (point-min) (point-max) encoding)))
+
(when (and strip-plaintext-regexps (not decrypt))
(dolist (re strip-plaintext-regexps)
(let ((re (if (listp re) (car re) re))
(error "decryption failed")))))
(setq result-text
- (buffer-substring 1 (- (point-max) (if decrypt 0 1))))
+ (buffer-substring-no-properties
+ 1 (- (point-max) (if decrypt 0 1))))
)
;; validate result - non-empty
The key type is one of 'symmetric or 'keypair.
-if 'keypair, and some of the user's secret keys are among those for which
-the message was encoded, return the identity of the first. otherwise,
+If 'keypair, and some of the user's secret keys are among those for which
+the message was encoded, return the identity of the first. Otherwise,
return nil for the second item of the pair.
An error is raised if the text is not encrypted."
See `allout-passphrase-verifier-string' and `allout-passphrase-hint-string'
settings.
-PASSPHRASE is the passphrase being mnemonicized
+PASSPHRASE is the passphrase being mnemonicized.
OUTLINE-BUFFER is the buffer of the outline being adjusted.
from encryption. This supports 'except-current mode of
`allout-encrypt-unencrypted-on-saves'.
-Such a topic has the allout-topic-encryption-bullet without an
+Such a topic has the `allout-topic-encryption-bullet' without an
immediately following '*' that would mark the topic as being encrypted. It
must also have content."
(let (done got content-beg)
)
;;;_ #9 miscellaneous
-;;;_ > allout-mark-topic ()
-(defun allout-mark-topic ()
- "Put the region around topic currently containing point."
- (interactive)
- (let ((inhibit-field-text-motion t))
- (beginning-of-line))
- (allout-goto-prefix)
- (push-mark (point))
- (allout-end-of-current-subtree)
- (exchange-point-and-mark))
-;;;_ > outlineify-sticky ()
+;;;_ : Mode:
+;;;_ > outlineify-sticky ()
;; outlinify-sticky is correct spelling; provide this alias for sticklers:
;;;###autoload
(defalias 'outlinify-sticky 'outlineify-sticky)
(save-excursion
(goto-char (point-min))
- (if (looking-at allout-regexp)
+ (if (allout-goto-prefix)
t
(allout-open-topic 2)
(insert (concat "Dummy outline topic header - see"
"`allout-mode' docstring: `^Hm'."))
(allout-adjust-file-variable
"allout-layout" (or allout-layout '(-1 : 0))))))
-;;;_ > allout-file-vars-section-data ()
+;;;_ > allout-file-vars-section-data ()
(defun allout-file-vars-section-data ()
"Return data identifying the file-vars section, or nil if none.
)
)
)
-;;;_ > allout-adjust-file-variable (varname value)
+;;;_ > allout-adjust-file-variable (varname value)
(defun allout-adjust-file-variable (varname value)
- "Adjust the setting of an emacs file variable named VARNAME to VALUE.
+ "Adjust the setting of an Emacs file variable named VARNAME to VALUE.
This activity is inhibited if either `enable-local-variables'
`allout-enable-file-variable-adjustment' are nil.
When enabled, an entry for the variable is created if not already present,
or changed if established with a different value. The section for the file
variables, itself, is created if not already present. When created, the
-section lines \(including the section line) exist as second-level topics in
+section lines (including the section line) exist as second-level topics in
a top-level topic at the end of the file.
-enable-local-variables must be true for any of this to happen."
+`enable-local-variables' must be true for any of this to happen."
(if (not (and enable-local-variables
allout-enable-file-variable-adjustment))
nil
)
)
)
-;;;_ > solicit-char-in-string (prompt string &optional do-defaulting)
+;;;_ > allout-get-configvar-values (varname)
+(defun allout-get-configvar-values (configvar-name)
+ "Return a list of values of the symbols in list bound to CONFIGVAR-NAME.
+
+The user is prompted for removal of symbols that are unbound, and they
+otherwise are ignored.
+
+CONFIGVAR-NAME should be the name of the configuration variable,
+not its value."
+
+ (let ((configvar-value (symbol-value configvar-name))
+ got)
+ (dolist (sym configvar-value)
+ (if (not (boundp sym))
+ (if (yes-or-no-p (format "%s entry `%s' is unbound - remove it? "
+ configvar-name sym))
+ (delq sym (symbol-value configvar-name)))
+ (push (symbol-value sym) got)))
+ (reverse got)))
+;;;_ : Topics:
+;;;_ > allout-mark-topic ()
+(defun allout-mark-topic ()
+ "Put the region around topic currently containing point."
+ (interactive)
+ (let ((inhibit-field-text-motion t))
+ (beginning-of-line))
+ (allout-goto-prefix-doublechecked)
+ (push-mark (point))
+ (allout-end-of-current-subtree)
+ (exchange-point-and-mark))
+;;;_ : UI:
+;;;_ > 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.
;; got something out of loop - return it:
got)
)
-;;;_ > regexp-sans-escapes (string)
+;;;_ : Strings:
+;;;_ > regexp-sans-escapes (string)
(defun regexp-sans-escapes (regexp &optional successive-backslashes)
"Return a copy of REGEXP with all character escapes stripped out.
(regexp-sans-escapes (substring regexp 1)))
;; Exclude first char, but maintain count:
(regexp-sans-escapes (substring regexp 1) successive-backslashes))))
-;;;_ > count-trailing-whitespace-region (beg end)
+;;;_ > count-trailing-whitespace-region (beg end)
(defun count-trailing-whitespace-region (beg end)
"Return number of trailing whitespace chars between BEG and END.
(goto-char beg)
(let ((count 0))
(while (re-search-forward "[ ][ ]*$" end t)
- (goto-char (1+ (match-beginning 0)))
+ (goto-char (1+ (match-beginning 2)))
(setq count (1+ count)))
count))))
-;;;_ > allout-get-configvar-values (varname)
-(defun allout-get-configvar-values (configvar-name)
- "Return a list of values of the symbols in list bound to CONFIGVAR-NAME.
-
-The user is prompted for removal of symbols that are unbound, and they
-otherwise are ignored.
-
-CONFIGVAR-NAME should be the name of the configuration variable,
-not its value."
-
- (let ((configvar-value (symbol-value configvar-name))
- got)
- (dolist (sym configvar-value)
- (if (not (boundp sym))
- (if (yes-or-no-p (format "%s entry `%s' is unbound - remove it? "
- configvar-name sym))
- (delq sym (symbol-value configvar-name)))
- (push (symbol-value sym) got)))
- (reverse got)))
-;;;_ > allout-mark-marker to accommodate divergent emacsen:
+;;;_ > allout-format-quote (string)
+(defun allout-format-quote (string)
+ "Return a copy of string with all \"%\" characters doubled."
+ (apply 'concat
+ (mapcar (lambda (char) (if (= char ?%) "%%" (char-to-string char)))
+ string)))
+;;;_ : lists
+;;;_ > allout-flatten (list)
+(defun allout-flatten (list)
+ "Return a list of all atoms in list."
+ ;; classic.
+ (cond ((null list) nil)
+ ((atom (car list)) (cons (car list) (allout-flatten (cdr list))))
+ (t (append (allout-flatten (car list)) (allout-flatten (cdr list))))))
+;;;_ : Compatibility:
+;;;_ > allout-mark-marker to accommodate divergent emacsen:
(defun allout-mark-marker (&optional force buffer)
"Accommodate the different signature for `mark-marker' across Emacsen.
(if (featurep 'xemacs)
(apply 'mark-marker force buffer)
(mark-marker)))
-;;;_ > subst-char-in-string if necessary
+;;;_ > subst-char-in-string if necessary
(if (not (fboundp 'subst-char-in-string))
(defun subst-char-in-string (fromchar tochar string &optional inplace)
"Replace FROMCHAR with TOCHAR in STRING each time it occurs.
(if (eq (aref newstr i) fromchar)
(aset newstr i tochar)))
newstr)))
-;;;_ > wholenump if necessary
+;;;_ > wholenump if necessary
(if (not (fboundp 'wholenump))
(defalias 'wholenump 'natnump))
-;;;_ > remove-overlays if necessary
+;;;_ > remove-overlays if necessary
(if (not (fboundp 'remove-overlays))
(defun remove-overlays (&optional beg end name val)
"Clear BEG and END of overlays whose property NAME has value VAL.
(move-overlay o end (overlay-end o))
(delete-overlay o)))))))
)
-;;;_ > copy-overlay if necessary - xemacs ~ 21.4
+;;;_ > copy-overlay if necessary - xemacs ~ 21.4
(if (not (fboundp 'copy-overlay))
(defun copy-overlay (o)
"Return a copy of overlay O."
(while props
(overlay-put o1 (pop props) (pop props)))
o1)))
-;;;_ > add-to-invisibility-spec if necessary - xemacs ~ 21.4
+;;;_ > add-to-invisibility-spec if necessary - xemacs ~ 21.4
(if (not (fboundp 'add-to-invisibility-spec))
(defun add-to-invisibility-spec (element)
"Add ELEMENT to `buffer-invisibility-spec'.
(setq buffer-invisibility-spec (list t)))
(setq buffer-invisibility-spec
(cons element buffer-invisibility-spec))))
-;;;_ > remove-from-invisibility-spec if necessary - xemacs ~ 21.4
+;;;_ > remove-from-invisibility-spec if necessary - xemacs ~ 21.4
(if (not (fboundp 'remove-from-invisibility-spec))
(defun remove-from-invisibility-spec (element)
"Remove ELEMENT from `buffer-invisibility-spec'."
(if (consp buffer-invisibility-spec)
(setq buffer-invisibility-spec (delete element
buffer-invisibility-spec)))))
-;;;_ > move-beginning-of-line if necessary - older emacs, xemacs
+;;;_ > move-beginning-of-line if necessary - older emacs, xemacs
(if (not (fboundp 'move-beginning-of-line))
(defun move-beginning-of-line (arg)
"Move point to beginning of current line as displayed.
(skip-chars-backward "^\n"))
(vertical-motion 0))
)
-;;;_ > move-end-of-line if necessary - older emacs, xemacs
+;;;_ > move-end-of-line if necessary - older emacs, xemacs
(if (not (fboundp 'move-end-of-line))
(defun move-end-of-line (arg)
"Move point to end of current line as displayed.
(setq arg 1)
(setq done t)))))))
)
-;;;_ > line-move-invisible-p if necessary
+;;;_ > line-move-invisible-p if necessary
(if (not (fboundp 'line-move-invisible-p))
(defun line-move-invisible-p (pos)
"Return non-nil if the character after POS is currently invisible."
;;;_ #10 Unfinished
;;;_ > allout-bullet-isearch (&optional bullet)
(defun allout-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
(defvar allout-tests-globally-unbound nil
"Fodder for allout resumptions tests - defvar just for byte compiler.")
(defvar allout-tests-globally-true nil
- "Fodder for allout resumptions tests - defvar just just for byte compiler.")
+ "Fodder for allout resumptions tests - defvar just for byte compiler.")
(defvar allout-tests-locally-true nil
"Fodder for allout resumptions tests - defvar just for byte compiler.")
(defun allout-test-resumptions ()
HCoop / bpt / emacs.git / blobdiff