;;; 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>
-;; Created: Dec 1991 - first release to usenet
+;; Created: Dec 1991 -- first release to usenet
;; Version: 2.2.1
;; Keywords: outlines wp languages
;; Website: http://myriadicity.net/Sundry/EmacsAllout
;; 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,
;; - Topic-oriented editing including coherent topic and subtopic
;; creation, promotion, demotion, cut/paste across depths, etc.
;; - Incremental search with dynamic exposure and reconcealment of text
-;; - Customizable bullet format - enables programming-language specific
+;; - Customizable bullet format -- enables programming-language specific
;; outlining, for code-folding editing. (Allout code itself is to try it;
-;; formatted as an outline - do ESC-x eval-buffer in allout.el; but
+;; formatted as an outline -- do ESC-x eval-buffer in allout.el; but
;; emacs local file variables need to be enabled when the
-;; file was visited - see `enable-local-variables'.)
+;; file was visited -- see `enable-local-variables'.)
;; - Configurable per-file initial exposure settings
;; - 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)
;; - Easy rendering of exposed portions into numbered, latex, indented, etc
;; outline styles
-;; - Careful attention to whitespace - enabling blank lines between items
+;; - Careful attention to whitespace -- enabling blank lines between items
;; and maintenance of hanging indentation (in paragraph auto-fill and
;; across topic promotion and demotion) of topic bodies consistent with
;; indentation of their topic header.
;; `allout-mode' as a minor mode. (It has changed since allout
;; 3.x, for those of you that depend on the old method.)
;;
-;; Note - the lines beginning with `;;;_' are outline topic headers.
+;; Note -- the lines beginning with `;;;_' are outline topic headers.
;; Just `ESC-x eval-buffer' to give it a whirl.
;; ken manheimer (ken dot manheimer at gmail dot com)
;;;_ + Layout, Mode, and Topic Header Configuration
+;;;_ = allout-command-prefix
+(defcustom allout-command-prefix "\C-c "
+ "*Key sequence to be used as prefix for outline mode command key bindings.
+
+Default is '\C-c<space>'; just '\C-c' is more short-and-sweet, if you're
+willing to let allout use a bunch of \C-c keybindings."
+ :type 'string
+ :group 'allout)
+
+;;;_ = allout-keybindings-list
+;;; You have to reactivate allout-mode -- `(allout-mode t)' -- to
+;;; institute changes to this var.
+(defvar allout-keybindings-list ()
+ "*List of `allout-mode' key / function bindings, for `allout-mode-map'.
+String or vector key will be prefaced with `allout-command-prefix',
+unless optional third, non-nil element is present.")
+(setq allout-keybindings-list
+ '(
+ ; Motion commands:
+ ("\C-n" allout-next-visible-heading)
+ ("\C-p" allout-previous-visible-heading)
+ ("\C-u" allout-up-current-level)
+ ("\C-f" allout-forward-current-level)
+ ("\C-b" allout-backward-current-level)
+ ("\C-a" allout-beginning-of-current-entry)
+ ("\C-e" allout-end-of-entry)
+ ; Exposure commands:
+ ("\C-i" allout-show-children)
+ ("\C-s" allout-show-current-subtree)
+ ("\C-h" allout-hide-current-subtree)
+ ("\C-t" allout-toggle-current-subtree-exposure)
+ ("h" allout-hide-current-subtree)
+ ("\C-o" allout-show-current-entry)
+ ("!" allout-show-all)
+ ("x" allout-toggle-current-subtree-encryption)
+ ; Alteration commands:
+ (" " allout-open-sibtopic)
+ ("." allout-open-subtopic)
+ ("," allout-open-supertopic)
+ ("'" allout-shift-in)
+ (">" allout-shift-in)
+ ("<" allout-shift-out)
+ ("\C-m" allout-rebullet-topic)
+ ("*" 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)
+ ("=c" allout-copy-exposed-to-buffer)
+ ("=i" allout-indented-exposed-to-buffer)
+ ("=t" allout-latexify-exposed)
+ ("=p" allout-flatten-exposed-to-buffer)))
+
;;;_ = allout-auto-activation
(defcustom allout-auto-activation nil
- "*Regulates auto-activation modality of allout outlines - see `allout-init'.
+ "*Regulates auto-activation modality of allout outlines -- see `allout-init'.
Setq-default by `allout-init' to regulate whether or not allout
outline mode is automatically activated when the buffer-specific
The types of elements in the layout specification are:
- integer - dictate the relative depth to open the corresponding topic(s),
- where:
- - negative numbers force the topic to be closed before opening
- to the absolute value of the number, so all siblings are open
- only to that level.
- - positive numbers open to the relative depth indicated by the
- number, but do not force already opened subtopics to be closed.
- - 0 means to close topic - hide all subitems.
- : - 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
- 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
- - - exposes the body of the corresponding topic, but not subtopics
- list - a nested layout spec, to be applied intricately to its
+ INTEGER -- dictate the relative depth to open the corresponding topic(s),
+ where:
+ -- negative numbers force the topic to be closed before opening
+ to the absolute value of the number, so all siblings are open
+ only to that level.
+ -- positive numbers open to the relative depth indicated by the
+ number, but do not force already opened subtopics to be closed.
+ -- 0 means to close topic -- hide all subitems.
+ : -- 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
+ 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
+ - -- exposes the body of the corresponding topic, but not subtopics
+ LIST -- a nested layout spec, to be applied intricately to its
corresponding item(s)
Examples:
- '(-2 : 0)
+ (-2 : 0)
Collapse the top-level topics to show their children and
grandchildren, but completely collapse the final top-level topic.
- '(-1 () : 1 0)
+ (-1 () : 1 0)
Close the first topic so only the immediate subtopics are shown,
leave the subsequent topics exposed as they are until the second
second to last topic, which is exposed at least one level, and
completely close the last topic.
- '(-2 : -1 *)
+ (-2 : -1 *)
Expose children and grandchildren of all topics at current
level except the last two; expose children of the second to
last and completely expose the last one, including its subtopics.
(const :tag "- (expose topic body but not offspring)" -)
(allout-layout-type :tag "<Nested layout>"))))
+;;;_ = allout-inhibit-auto-fill
+(defcustom allout-inhibit-auto-fill nil
+ "*If non-nil, auto-fill will be inhibited in the allout buffers.
+
+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.)
+
+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
+else allout's special hanging-indent maintaining auto-fill function,
+`allout-auto-fill'."
+ :type 'boolean
+ :group 'allout)
+(make-variable-buffer-local 'allout-inhibit-auto-fill)
+;;;_ = allout-use-hanging-indents
+(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
+where auto-fill occurs."
+ :type 'boolean
+ :group 'allout)
+(make-variable-buffer-local 'allout-use-hanging-indents)
+;;;###autoload
+(put 'allout-use-hanging-indents 'safe-local-variable
+ (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil)))))
+;;;_ = allout-reindent-bodies
+(defcustom allout-reindent-bodies (if allout-use-hanging-indents
+ 'text)
+ "*Non-nil enables auto-adjust of topic body hanging indent with depth shifts.
+
+When active, topic body lines that are indented even with or beyond
+their topic header are reindented to correspond with depth shifts of
+the header.
+
+A value of t enables reindent in non-programming-code buffers, ie
+those that do not have the variable `comment-start' set. A value of
+`force' enables reindent whether or not `comment-start' is set."
+ :type '(choice (const nil) (const t) (const text) (const force))
+ :group 'allout)
+
+(make-variable-buffer-local 'allout-reindent-bodies)
+;;;###autoload
+(put 'allout-reindent-bodies 'safe-local-variable
+ '(lambda (x) (memq x '(nil t text force))))
+
;;;_ = allout-show-bodies
(defcustom allout-show-bodies nil
"*If non-nil, show entire body when exposing a topic, rather than
Cycling only happens on when the command is repeated, not when it
follows a different command.
-Smart-placement means that repeated calls to this function will
+Smart placement means that repeated calls to this function will
advance as follows:
- if the cursor is not on the end-of-line,
(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]).
+
+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:
+
+ `(' - 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
+
+Some are more elusive, but their rationale may be recognizable:
- `?' 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
+ `+' - plus -- pending consideration, completion
+ `_' - underscore -- done, completed
+ `&' - ampersand -- addendum, furthermore
- ... for example. (`#' typically has a special meaning to the software,
-according to the value of `allout-numbered-bullet'.)
+\(Some other non-plain bullets have special meaning to the
+software. By default:
-See `allout-plain-bullets-string' for the selection of
-alternating bullets.
+ `~' 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."
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.]"
;;;###autoload
(put 'allout-old-style-prefixes 'safe-local-variable
(if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil)))))
-;;;_ = allout-stylish-prefixes - alternating bullets
+;;;_ = allout-stylish-prefixes -- alternating bullets
(defcustom allout-stylish-prefixes t
"*Do fancy stuff with topic prefix bullets according to level, etc.
(defcustom allout-topic-encryption-bullet "~"
"*Bullet signifying encryption of the entry's body."
:type '(choice (const nil) string)
- :version "22.0"
+ :version "22.1"
:group 'allout-encryption)
;;;_ = allout-passphrase-verifier-handling
(defcustom allout-passphrase-verifier-handling t
See the docstring for the `allout-enable-file-variable-adjustment'
variable for details about allout ajustment of file variables."
:type 'boolean
- :version "22.0"
+ :version "22.1"
:group 'allout-encryption)
(make-variable-buffer-local 'allout-passphrase-verifier-handling)
;;;_ = allout-passphrase-hint-handling
(defcustom allout-passphrase-hint-handling 'always
"*Dictate outline encryption passphrase reminder handling:
- always - always show reminder when prompting
- needed - show reminder on passphrase entry failure
- disabled - never present or adjust reminder
+ always -- always show reminder when prompting
+ needed -- show reminder on passphrase entry failure
+ disabled -- never present or adjust reminder
See the docstring for the `allout-enable-file-variable-adjustment'
variable for details about allout ajustment of file variables."
:type '(choice (const always)
(const needed)
(const disabled))
- :version "22.0"
+ :version "22.1"
:group 'allout-encryption)
(make-variable-buffer-local 'allout-passphrase-hint-handling)
;;;_ = allout-encrypt-unencrypted-on-saves
can continue editing but the copy on the file system will be
encrypted.)
Auto-saves will use the \"All except current topic\" mode if this
- one is selected, to avoid practical difficulties - see below.
+ one is selected, to avoid practical difficulties -- see below.
- All except current topic: skip the topic currently being edited, even if
it's pending encryption. This may expose the current topic on the
file sytem, but avoids the nuisance of prompts for the encryption
:type '(choice (const :tag "Yes" t)
(const :tag "All except current topic" except-current)
(const :tag "No" nil))
- :version "22.0"
+ :version "22.1"
:group 'allout-encryption)
(make-variable-buffer-local 'allout-encrypt-unencrypted-on-saves)
;;;_ + Miscellaneous customization
-;;;_ = allout-command-prefix
-(defcustom allout-command-prefix "\C-c "
- "*Key sequence to be used as prefix for outline mode command key bindings.
-
-Default is '\C-c<space>'; just '\C-c' is more short-and-sweet, if you're
-willing to let allout use a bunch of \C-c keybindings."
- :type 'string
- :group 'allout)
-
-;;;_ = allout-keybindings-list
-;;; You have to reactivate allout-mode - `(allout-mode t)' - to
-;;; institute changes to this var.
-(defvar allout-keybindings-list ()
- "*List of `allout-mode' key / function bindings, for `allout-mode-map'.
-
-String or vector key will be prefaced with `allout-command-prefix',
-unless optional third, non-nil element is present.")
-(setq allout-keybindings-list
- '(
- ; Motion commands:
- ("\C-n" allout-next-visible-heading)
- ("\C-p" allout-previous-visible-heading)
- ("\C-u" allout-up-current-level)
- ("\C-f" allout-forward-current-level)
- ("\C-b" allout-backward-current-level)
- ("\C-a" allout-beginning-of-current-entry)
- ("\C-e" allout-end-of-entry)
- ; Exposure commands:
- ("\C-i" allout-show-children)
- ("\C-s" allout-show-current-subtree)
- ("\C-h" allout-hide-current-subtree)
- ("h" allout-hide-current-subtree)
- ("\C-o" allout-show-current-entry)
- ("!" allout-show-all)
- ("x" allout-toggle-current-subtree-encryption)
- ; Alteration commands:
- (" " allout-open-sibtopic)
- ("." allout-open-subtopic)
- ("," allout-open-supertopic)
- ("'" allout-shift-in)
- (">" allout-shift-in)
- ("<" allout-shift-out)
- ("\C-m" allout-rebullet-topic)
- ("*" 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)
- ("=c" allout-copy-exposed-to-buffer)
- ("=i" allout-indented-exposed-to-buffer)
- ("=t" allout-latexify-exposed)
- ("=p" allout-flatten-exposed-to-buffer)))
-
-;;;_ = allout-inhibit-auto-fill
-(defcustom allout-inhibit-auto-fill nil
- "*If non-nil, auto-fill will be inhibited in the allout buffers.
-
-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.)
-
-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
-else allout's special hanging-indent maintaining auto-fill function,
-`allout-auto-fill'."
- :type 'boolean
- :group 'allout)
-(make-variable-buffer-local 'allout-inhibit-auto-fill)
-
-;;;_ = allout-use-hanging-indents
-(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
-where auto-fill occurs."
- :type 'boolean
- :group 'allout)
-(make-variable-buffer-local 'allout-use-hanging-indents)
-;;;###autoload
-(put 'allout-use-hanging-indents 'safe-local-variable
- (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil)))))
-
-;;;_ = allout-reindent-bodies
-(defcustom allout-reindent-bodies (if allout-use-hanging-indents
- 'text)
- "*Non-nil enables auto-adjust of topic body hanging indent with depth shifts.
-
-When active, topic body lines that are indented even with or beyond
-their topic header are reindented to correspond with depth shifts of
-the header.
-
-A value of t enables reindent in non-programming-code buffers, ie
-those that do not have the variable `comment-start' set. A value of
-`force' enables reindent whether or not `comment-start' is set."
- :type '(choice (const nil) (const t) (const text) (const force))
- :group 'allout)
-
-(make-variable-buffer-local 'allout-reindent-bodies)
-;;;###autoload
-(put 'allout-reindent-bodies 'safe-local-variable
- '(lambda (x) (memq x '(nil t text force))))
-
;;;_ = allout-enable-file-variable-adjustment
(defcustom allout-enable-file-variable-adjustment t
"*If non-nil, some allout outline actions edit Emacs local file var text.
:group 'allout)
(make-variable-buffer-local 'allout-enable-file-variable-adjustment)
-;;;_* CODE - no user customizations below.
+;;;_* CODE -- no user customizations below.
;;;_ #1 Internal Outline Formatting and Configuration
;;;_ : Version
(defvar allout-mode nil "Allout outline mode minor-mode flag.")
(make-variable-buffer-local 'allout-mode)
;;;_ = allout-layout nil
-(defvar allout-layout nil ; LEAVE GLOBAL VALUE NIL - see docstring.
+(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
(defvar allout-bullets-string ""
"A string dictating the valid set of outline topic bullets.
-This var should *not* be set by the user - it is set by `set-allout-regexp',
+This var should *not* be set by the user -- it is set by `set-allout-regexp',
and is produced from the elements of `allout-plain-bullets-string'
and `allout-distinctive-bullets-string'.")
(make-variable-buffer-local 'allout-bullets-string)
(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.
+ "`allout-regexp' prepended with a newline for the search target.
This is properly set by `set-allout-regexp'.")
(make-variable-buffer-local 'allout-line-boundary-regexp)
(make-variable-buffer-local 'allout-plain-bullets-string-len)
;;;_ = allout-doublecheck-at-and-shallower
-(defconst allout-doublecheck-at-and-shallower 2
+(defconst allout-doublecheck-at-and-shallower 3
"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.")
+Verified with `allout-aberrant-container-p'. The usefulness of
+this check 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.
+
+The classic example of a mistaken item, for a standard allout
+outline configuration, is a body line that begins with an '...'
+ellipsis. This happens to contain a legitimate depth-2 header
+prefix, constituted by two '..' dots at the beginning of the
+line. The only thing that can distinguish it *in principle* from
+a legitimate one is if the following real header is at a depth
+that is discontinuous from the depth of 2 implied by the
+ellipsis, ie depth 4 or more. As the depth being tested gets
+greater, the likelihood of this kind of disqualification is
+lower, and the usefulness of this test is lower.
+
+Extending the depth of the doublecheck increases the amount it is
+applied, increasing the cost of the test - on casual estimation,
+for outlines with many deep topics, geometrically (O(n)?).
+Taken together with decreasing likelihood that the test will be
+useful at greater depths, more modest doublecheck limits are more
+suitably economical.")
;;;_ X allout-reset-header-lead (header-lead)
(defun allout-reset-header-lead (header-lead)
"*Reset the leading string used to identify topic headers."
comment-start
t)))
allout-use-mode-specific-leader
- ;; Oops - garbled value, equate with effect of 't:
+ ;; Oops -- garbled value, equate with effect of t:
t)))
(leader
(cond
nil
(setq allout-header-prefix leader)
(if (not allout-old-style-prefixes)
- ;; setting allout-primary-bullet makes the top level topics use -
- ;; actually, be - the special prefix:
+ ;; setting allout-primary-bullet makes the top level topics use --
+ ;; actually, be -- the special prefix:
(setq allout-primary-bullet leader))
allout-header-prefix)))
(defalias 'allout-infer-header-lead
(setq allout-plain-bullets-string-len (length allout-plain-bullets-string))
(setq allout-header-subtraction (1- (length allout-header-prefix)))
- (let (new-part old-part)
+ (let (new-part old-part formfeed-part)
(setq new-part (concat "\\("
(regexp-quote allout-header-prefix)
"[ \t]*"
"\\)"
"+"
" ?[^" allout-primary-bullet "]")
+ formfeed-part "\\(\^L\\)"
+
allout-regexp (concat new-part
"\\|"
old-part
- "\\|\^l")
+ "\\|"
+ formfeed-part)
allout-line-boundary-regexp (concat "\n" new-part
"\\|"
- "\n" old-part)
+ "\n" old-part
+ "\\|"
+ "\n" formfeed-part)
allout-bob-regexp (concat "\\`" new-part
"\\|"
- "\\`" old-part))
+ "\\`" old-part
+ "\\|"
+ "\\`" formfeed-part
+ ))
(setq allout-depth-specific-regexp
(concat "\\(^\\|\\`\\)"
(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
+ (mapc (function
(lambda (cell)
(let ((add-pref (null (cdr (cdr cell))))
(key-suff (list (car cell))))
(apply 'define-key
(list map
- (apply 'concat (if add-pref
+ (apply 'vconcat (if add-pref
(append pref key-suff)
key-suff))
(car (cdr cell)))))))
element of the pair onto the end of the existing value.
Extension, and resumptions in general, should not be used for hook
-functions - use the 'local mode of `add-hook' for that, instead.
+functions -- use the 'local mode of `add-hook' for that, instead.
The settings are stored on `allout-mode-prior-settings'."
(while pairs
(when (not (assoc name allout-mode-prior-settings))
;; Not already added as a resumption, create the prior setting entry.
(if (local-variable-p name)
- ;; is already local variable - preserve the prior value:
+ ;; is already local variable -- preserve the prior value:
(push (list name prior-value) allout-mode-prior-settings)
;; wasn't local variable, indicate so for resumption by killing
;; local value, and make it local:
Functions on the hook must take three arguments:
- - from - integer indicating the point at the start of the change.
- - to - integer indicating the point of the end of the change.
- - flag - change mode: nil for exposure, otherwise concealment.
+ - FROM -- integer indicating the point at the start of the change.
+ - TO -- integer indicating the point of the end of the change.
+ - FLAG -- change mode: nil for exposure, otherwise concealment.
This hook might be invoked multiple times by a single command.
Functions on the hook should take two arguments:
- - new-start - integer indicating the point at the start of the first new item.
- - new-end - integer indicating the point of the end of the last new item.
+ - NEW-START -- integer indicating position of start of the first new item.
+ - NEW-END -- integer indicating position of end of the last new item.
-Some edits that introduce new items may missed by this hook -
+Some edits that introduce new items may missed by this hook:
specifically edits that native allout routines do not control.
This hook might be invoked multiple times by a single command.")
Functions on the hook must take two arguments:
- - depth - integer indicating the depth of the subtree that was deleted.
- - removed-from - integer indicating the point where the subtree was removed.
+ - DEPTH -- integer indicating the depth of the subtree that was deleted.
+ - REMOVED-FROM -- integer indicating the point where the subtree was removed.
-Some edits that remove or invalidate items may missed by this hook -
+Some edits that remove or invalidate items may missed by this hook:
specifically edits that native allout routines do not control.
This hook might be invoked multiple times by a single command.")
Functions on the hook should take two arguments:
- - depth-change - integer indicating depth increase, negative for decrease
- - start - integer indicating the start point of the shifted parent item.
+ - DEPTH-CHANGE -- integer indicating depth increase, negative for decrease
+ - START -- integer indicating the start point of the shifted parent item.
-Some edits that shift items can be missed by this hook - specifically edits
+Some edits that shift items can be missed by this hook: specifically edits
that native allout routines do not control.
This hook might be invoked multiple times by a single command.")
"Variable for regexps matching plaintext to remove before encryption.
This is for the sake of redoing encryption in cases where the ciphertext
-incidentally contains strings that would disrupt mode operation -
+incidentally contains strings that would disrupt mode operation --
for example, a line that happens to look like an allout-mode topic prefix.
Entries must be symbols that are bound to the desired regexp values.
(make-variable-buffer-local 'allout-encryption-ciphertext-rejection-ceiling)
;;;_ > allout-mode-p ()
;; Must define this macro above any uses, or byte compilation will lack
-;; proper def, if file isn't loaded - eg, during emacs build!
+;; proper def, if file isn't loaded -- eg, during emacs build!
(defmacro allout-mode-p ()
"Return t if `allout-mode' is active in current buffer."
'allout-mode)
(condition-case failure
(setq allout-after-save-decrypt
(allout-encrypt-decrypted except-mark))
- (error (progn
- (message
- "allout-write-file-hook-handler suppressing error %s"
- failure)
- (sit-for 2))))))
+ (error (message
+ "allout-write-file-hook-handler suppressing error %s"
+ failure)
+ (sit-for 2)))))
))
- nil)
+ nil)
;;;_ > allout-auto-save-hook-handler ()
(defun allout-auto-save-hook-handler ()
"Implement `allout-encrypt-unencrypted-on-saves' policy for auto save."
(put 'allout-exposure-category 'invisible 'allout)
(put 'allout-exposure-category 'evaporate t)
;; XXX We use isearch-open-invisible *and* isearch-mode-end-hook. The
- ;; latter would be sufficient, but it seems that a separate behavior -
- ;; the _transient_ opening of invisible text during isearch - is keyed to
- ;; presence of the isearch-open-invisible property - even though this
+ ;; latter would be sufficient, but it seems that a separate behavior --
+ ;; the _transient_ opening of invisible text during isearch -- is keyed to
+ ;; presence of the isearch-open-invisible property -- even though this
;; property controls the isearch _arrival_ behavior. This is the case at
- ;; least in emacs 21, 22.0, and xemacs 21.4.
+ ;; least in emacs 21, 22.1, and xemacs 21.4.
(put 'allout-exposure-category 'isearch-open-invisible
'allout-isearch-end-handler)
(if (featurep 'xemacs)
"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
`\\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
+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.
\\[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
+\\[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).
\\[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
+ 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 -
+\\[allout-number-siblings] `allout-number-siblings' Number bullets of topic and siblings --
the offspring are not affected.
With repeat count, revoke numbering.
\\[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*\".
+ 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
Terminology
-Topic hierarchy constituents - TOPICS and SUBTOPICS:
+Topic hierarchy constituents -- TOPICS and SUBTOPICS:
ITEM: A unitary outline element, including the HEADER and ENTRY text.
TOPIC: An ITEM and any ITEMs contained within it, ie having greater DEPTH
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'. (See the documentation
- for these variables for more details.) The default choice of
- BULLET when generating ITEMs varies in a cycle with the DEPTH of
- the ITEM.
-
+ `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 ENTRY text.
(cond
- ;; Provision for v19.18, 19.19 bug -
+ ;; Provision for v19.18, 19.19 bug --
;; Emacs v 19.18, 19.19 file-var code invokes prop-line-designated
;; modes twice when file is visited. We have to avoid toggling mode
;; off on second invocation, so we detect it as best we can, and
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)
(progn
(apply 'allout-expose-topic (list use-layout))
(message "Adjusting '%s' exposure... done." (buffer-name)))
- ;; Problem applying exposure - notify user, but don't
+ ;; Problem applying exposure -- notify user, but don't
;; interrupt, eg, file visit:
(error (message "%s" (car (cdr err)))
(sit-for 1))))))
;;;_ > allout-minor-mode
(defalias 'allout-minor-mode 'allout-mode)
+;;;_ > allout-unload-function
+(defun allout-unload-function ()
+ "Unload the allout outline library."
+ (save-current-buffer
+ (dolist (buffer (buffer-list))
+ (set-buffer buffer)
+ (when allout-mode (allout-mode -1))))
+ ;; continue standard unloading
+ nil)
+
;;;_ - Position Assessment
;;;_ > allout-hidden-p (&optional pos)
(defsubst allout-hidden-p (&optional pos)
;;; &optional prelen)
(defun allout-overlay-insert-in-front-handler (ol after beg end
&optional prelen)
- "Shift the overlay so stuff inserted in front of it are excluded."
+ "Shift the overlay so stuff inserted in front of it is excluded."
(if after
+ ;; XXX Shouldn't moving the overlay should be unnecessary, if overlay
+ ;; front-advance on the overlay worked as it should?
(move-overlay ol (1+ beg) (overlay-end ol))))
;;;_ > allout-overlay-interior-modification-handler (ol after beg end
;;; &optional prelen)
"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))
(when (and (featurep 'xemacs) (allout-mode-p))
;; process all of the pending overlays:
(save-excursion
- (got-char beg)
+ (goto-char beg)
(let ((overlay (allout-get-invisibility-overlay)))
(allout-overlay-interior-modification-handler
overlay nil beg end nil)))))
(if (and (allout-mode-p) (allout-hidden-p))
(allout-show-to-offshoot)))
-;;;_ #3 Internal Position State-Tracking - "allout-recent-*" funcs
+;;;_ #3 Internal Position State-Tracking -- "allout-recent-*" funcs
;;; All the basic outline functions that directly do string matches to
;;; evaluate heading prefix location set the variables
;;; `allout-recent-prefix-beginning' and `allout-recent-prefix-end'
(defsubst allout-prefix-data ()
"Register allout-prefix state data.
-For reference by `allout-recent' funcs. Returns BEGINNING."
- (setq allout-recent-prefix-end (or (match-end 1) (match-end 2))
+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) (match-end 3))
allout-recent-prefix-beginning (or (match-beginning 1)
- (match-beginning 2))
+ (match-beginning 2)
+ (match-beginning 3))
allout-recent-depth (max 1 (- allout-recent-prefix-end
allout-recent-prefix-beginning
allout-header-subtraction)))
(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,
+ ;; 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:
(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)))))
+ (save-match-data
+ (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)
Actually, returns prefix beginning point."
(save-excursion
(allout-beginning-of-current-line)
- (and (looking-at allout-regexp)
- (allout-prefix-data)
- (or (not (allout-do-doublecheck))
- (not (allout-aberrant-container-p))))))
+ (save-match-data
+ (and (looking-at allout-regexp)
+ (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 ()
(defun allout-e-o-prefix-p ()
"True if point is located where current topic prefix ends, heading begins."
- (and (save-excursion (let ((inhibit-field-text-motion t))
- (beginning-of-line))
- (looking-at allout-regexp))
- (= (point)(save-excursion (allout-end-of-prefix)(point)))))
+ (and (save-match-data
+ (save-excursion (let ((inhibit-field-text-motion t))
+ (beginning-of-line))
+ (looking-at allout-regexp))
+ (= (point) (save-excursion (allout-end-of-prefix)(point))))))
;;;_ : Location attributes
;;;_ > allout-depth ()
(defun allout-depth ()
"Return depth of topic most immediately containing point.
+Does not do doublecheck for aberrant topic header.
+
Return zero if point is not within any topic.
Like `allout-current-depth', but respects hidden as well as visible topics."
;;;_ > allout-end-of-current-line ()
(defun allout-end-of-current-line ()
"Move to the end of line, past concealed text if any."
- ;; XXX This is for symmetry with `allout-beginning-of-current-line' -
+ ;; XXX This is for symmetry with `allout-beginning-of-current-line' --
;; `move-end-of-line' doesn't suffer the same problem as
;; `move-beginning-of-line'.
(let ((inhibit-field-text-motion t))
(if (or (not allout-beginning-of-line-cycles)
(not (equal last-command this-command)))
- (move-beginning-of-line 1)
+ (progn
+ (if (and (not (bolp))
+ (allout-hidden-p (1- (point))))
+ (goto-char (previous-single-char-property-change
+ (1- (point)) 'invisible)))
+ (move-beginning-of-line 1))
(allout-depth)
(let ((beginning-of-body
(save-excursion
((>= (point) end-of-entry)
(allout-back-to-current-heading)
(allout-end-of-current-line))
- (t (allout-end-of-entry))))))
+ (t
+ (if (not (and transient-mark-mode mark-active))
+ (push-mark))
+ (allout-end-of-entry))))))
;;;_ > allout-next-heading ()
(defsubst allout-next-heading ()
"Move to the heading for the topic (possibly invisible) after this one.
Returns the location of the heading, or nil if none found.
-We skip anomolous low-level topics, a la `allout-aberrant-container-p'."
- (if (looking-at allout-regexp)
- (forward-char 1))
-
- (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)))
+We skip anomalous low-level topics, a la `allout-aberrant-container-p'."
+ (save-match-data
+
+ (if (looking-at allout-regexp)
+ (forward-char 1))
+
+ (when (re-search-forward allout-line-boundary-regexp nil 0)
+ (allout-prefix-data)
+ (goto-char allout-recent-prefix-beginning)
+ (while (not (bolp))
+ (forward-char -1))
+ (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))
+ ;; this may or may not be the same as above depending on doublecheck:
+ (goto-char allout-recent-prefix-beginning))))
;;;_ > allout-this-or-next-heading
(defun allout-this-or-next-heading ()
"Position cursor on current or next heading."
Return the location of the beginning of the heading, or nil if not found.
-We skip anomolous low-level topics, a la `allout-aberrant-container-p'."
+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))))))
+ (save-match-data
+ (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."
;; Register this one and move on:
(setq chart (cons allout-recent-prefix-beginning chart))
(if (and levels (<= levels 1))
- ;; At depth limit - skip sublevels:
+ ;; At depth limit -- skip sublevels:
(or (allout-next-sibling curr-depth)
- ;; or no more siblings - proceed to
+ ;; or no more siblings -- proceed to
;; next heading at lesser depth:
(while (and (<= curr-depth
allout-recent-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
+ ;; We're on the start of a subtree -- recurse with it, if there's
;; more depth to go:
(if further (setq result (append further result)))
(setq chart (cdr chart)))
Returns the point at the beginning of the prefix, or nil if none."
- (let (done)
- (while (and (not done)
- (search-backward "\n" nil 1))
- (forward-char 1)
- (if (looking-at allout-regexp)
- (setq done (allout-prefix-data))
- (forward-char -1)))
- (if (bobp)
- (cond ((looking-at allout-regexp)
- (allout-prefix-data))
- ((allout-next-heading))
- (done))
- done)))
+ (save-match-data
+ (let (done)
+ (while (and (not done)
+ (search-backward "\n" nil 1))
+ (forward-char 1)
+ (if (looking-at allout-regexp)
+ (setq done (allout-prefix-data))
+ (forward-char -1)))
+ (if (bobp)
+ (cond ((looking-at allout-regexp)
+ (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.
(if (not (allout-goto-prefix-doublechecked))
nil
(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)))
+ (save-match-data
+ (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 ()
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)))
+ (setq found (save-match-data
+ (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)))))
(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,
+ ;; 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))
(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:
+ (save-match-data
+ (if (not (looking-at allout-regexp))
+ ;; not a header line, keep looking:
t
- ;; this prospective headerline qualifies - register:
- (setq got allout-recent-prefix-beginning)
- ;; and break the loop:
- nil))))
+ (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)))
;; translate literal membership on list:
(cadr (assoc key-string allout-keybindings-list)))
;; translate as a keybinding:
- (key-binding (concat allout-command-prefix
+ (key-binding (vconcat allout-command-prefix
(char-to-string
(if (and (<= 97 key-num) ; "a"
(>= 122 key-num)) ; "z"
(- key-num 96) key-num)))
t))))
- ;; Qualified as an allout command - do hot-spot operation.
+ ;; 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))))
topic at point, if non-nil. Default bullet for new topics, eg, may
be set (contingent to other args) to numbered bullets if previous
sibling is one. The implication otherwise is that the current topic
-is being adjusted - shifted or rebulleted - and we don't consider
+is being adjusted -- shifted or rebulleted -- and we don't consider
bullet or previous sibling.
Third arg DEPTH forces the topic prefix to that depth, regardless of
;; Getting value for bullet char is practically the whole job:
(cond
- ; Simplest situation - level 1:
+ ; Simplest situation -- level 1:
((<= depth 1) (setq header-lead "") allout-primary-bullet)
; Simple, too: all asterisks:
(allout-old-style-prefixes
- ;; Cheat - make body the whole thing, null out header-lead and
+ ;; Cheat -- make body the whole thing, null out header-lead and
;; bullet-char:
(setq body (make-string depth
(string-to-char allout-primary-bullet)))
"Open a new topic at depth DEPTH.
New topic is situated after current one, unless optional flag BEFORE
-is non-nil, or unless current line is completely empty - lacking even
-whitespace - in which case open is done on the current line.
+is non-nil, or unless current line is completely empty -- lacking even
+whitespace -- in which case open is done on the current line.
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
from there."
(allout-beginning-of-current-line)
- (let* ((inhibit-field-text-motion t)
- (depth (+ (allout-current-depth) relative-depth))
- (opening-on-blank (if (looking-at "^\$")
- (not (setq before nil))))
- ;; bunch o vars set while computing ref-topic
- opening-numbered
- ref-depth
- ref-bullet
- (ref-topic (save-excursion
- (cond ((< relative-depth 0)
- (allout-ascend-to-depth depth))
- ((>= relative-depth 1) nil)
- (t (allout-back-to-current-heading)))
- (setq ref-depth allout-recent-depth)
- (setq ref-bullet
- (if (> allout-recent-prefix-end 1)
- (allout-recent-bullet)
- ""))
- (setq opening-numbered
- (save-excursion
- (and allout-numbered-bullet
- (or (<= relative-depth 0)
- (allout-descend-to-depth depth))
- (if (allout-numbered-type-prefix)
- allout-numbered-bullet))))
- (point)))
- dbl-space
- doing-beginning
- start end)
-
- (if (not opening-on-blank)
+ (save-match-data
+ (let* ((inhibit-field-text-motion t)
+ (depth (+ (allout-current-depth) relative-depth))
+ (opening-on-blank (if (looking-at "^\$")
+ (not (setq before nil))))
+ ;; bunch o vars set while computing ref-topic
+ opening-numbered
+ ref-depth
+ ref-bullet
+ (ref-topic (save-excursion
+ (cond ((< relative-depth 0)
+ (allout-ascend-to-depth depth))
+ ((>= relative-depth 1) nil)
+ (t (allout-back-to-current-heading)))
+ (setq ref-depth allout-recent-depth)
+ (setq ref-bullet
+ (if (> allout-recent-prefix-end 1)
+ (allout-recent-bullet)
+ ""))
+ (setq opening-numbered
+ (save-excursion
+ (and allout-numbered-bullet
+ (or (<= relative-depth 0)
+ (allout-descend-to-depth depth))
+ (if (allout-numbered-type-prefix)
+ allout-numbered-bullet))))
+ (point)))
+ dbl-space
+ doing-beginning
+ start end)
+
+ (if (not opening-on-blank)
; Positioning and vertical
- ; padding - only if not
+ ; padding -- only if not
; opening-on-blank:
- (progn
- (goto-char ref-topic)
- (setq dbl-space ; Determine double space action:
- (or (and (<= relative-depth 0) ; not descending;
- (save-excursion
- ;; at b-o-b or preceded by a blank line?
- (or (> 0 (forward-line -1))
- (looking-at "^\\s-*$")
- (bobp)))
- (save-excursion
- ;; succeeded by a blank line?
- (allout-end-of-current-subtree)
- (looking-at "\n\n")))
- (and (= ref-depth 1)
- (or before
- (= depth 1)
- (save-excursion
- ;; Don't already have following
- ;; vertical padding:
- (not (allout-pre-next-prefix)))))))
-
- ;; Position to prior heading, if inserting backwards, and not
- ;; going outwards:
- (if (and before (>= relative-depth 0))
- (progn (allout-back-to-current-heading)
- (setq doing-beginning (bobp))
- (if (not (bobp))
- (allout-previous-heading)))
- (if (and before (bobp))
- (open-line 1)))
-
- (if (<= relative-depth 0)
- ;; Not going inwards, don't snug up:
- (if doing-beginning
- (if (not dbl-space)
- (open-line 1)
- (open-line 2))
- (if before
- (progn (end-of-line)
- (allout-pre-next-prefix)
- (while (and (= ?\n (following-char))
- (save-excursion
- (forward-char 1)
- (allout-hidden-p)))
- (forward-char 1))
- (if (not (looking-at "^$"))
- (open-line 1)))
- (allout-end-of-current-subtree)
- (if (looking-at "\n\n") (forward-char 1))))
- ;; Going inwards - double-space if first offspring is
- ;; double-spaced, otherwise snug up.
- (allout-end-of-entry)
- (if (eobp)
- (newline 1)
- (line-move 1))
- (allout-beginning-of-current-line)
- (backward-char 1)
- (if (bolp)
- ;; Blank lines between current header body and next
- ;; header - get to last substantive (non-white-space)
- ;; line in body:
- (progn (setq dbl-space t)
- (re-search-backward "[^ \t\n]" nil t)))
- (if (looking-at "\n\n")
- (setq dbl-space t))
- (if (save-excursion
- (allout-next-heading)
- (when (> allout-recent-depth ref-depth)
- ;; This is an offspring.
- (forward-line -1)
- (looking-at "^\\s-*$")))
- (progn (forward-line 1)
- (open-line 1)
- (forward-line 1)))
- (allout-end-of-current-line))
-
- ;;(if doing-beginning (goto-char doing-beginning))
- (if (not (bobp))
- ;; We insert a newline char rather than using open-line to
- ;; avoid rear-stickiness inheritence of read-only property.
- (progn (if (and (not (> depth ref-depth))
- (not before))
+ (progn
+ (goto-char ref-topic)
+ (setq dbl-space ; Determine double space action:
+ (or (and (<= relative-depth 0) ; not descending;
+ (save-excursion
+ ;; at b-o-b or preceded by a blank line?
+ (or (> 0 (forward-line -1))
+ (looking-at "^\\s-*$")
+ (bobp)))
+ (save-excursion
+ ;; succeeded by a blank line?
+ (allout-end-of-current-subtree)
+ (looking-at "\n\n")))
+ (and (= ref-depth 1)
+ (or before
+ (= depth 1)
+ (save-excursion
+ ;; Don't already have following
+ ;; vertical padding:
+ (not (allout-pre-next-prefix)))))))
+
+ ;; Position to prior heading, if inserting backwards, and not
+ ;; going outwards:
+ (if (and before (>= relative-depth 0))
+ (progn (allout-back-to-current-heading)
+ (setq doing-beginning (bobp))
+ (if (not (bobp))
+ (allout-previous-heading)))
+ (if (and before (bobp))
+ (open-line 1)))
+
+ (if (<= relative-depth 0)
+ ;; Not going inwards, don't snug up:
+ (if doing-beginning
+ (if (not dbl-space)
+ (open-line 1)
+ (open-line 2))
+ (if before
+ (progn (end-of-line)
+ (allout-pre-next-prefix)
+ (while (and (= ?\n (following-char))
+ (save-excursion
+ (forward-char 1)
+ (allout-hidden-p)))
+ (forward-char 1))
+ (if (not (looking-at "^$"))
+ (open-line 1)))
+ (allout-end-of-current-subtree)
+ (if (looking-at "\n\n") (forward-char 1))))
+ ;; Going inwards -- double-space if first offspring is
+ ;; double-spaced, otherwise snug up.
+ (allout-end-of-entry)
+ (if (eobp)
+ (newline 1)
+ (line-move 1))
+ (allout-beginning-of-current-line)
+ (backward-char 1)
+ (if (bolp)
+ ;; Blank lines between current header body and next
+ ;; header -- get to last substantive (non-white-space)
+ ;; line in body:
+ (progn (setq dbl-space t)
+ (re-search-backward "[^ \t\n]" nil t)))
+ (if (looking-at "\n\n")
+ (setq dbl-space t))
+ (if (save-excursion
+ (allout-next-heading)
+ (when (> allout-recent-depth ref-depth)
+ ;; This is an offspring.
+ (forward-line -1)
+ (looking-at "^\\s-*$")))
+ (progn (forward-line 1)
(open-line 1)
- (if (and (not dbl-space) (> depth ref-depth))
- (newline 1)
- (if dbl-space
- (open-line 1)
- (if (not before)
- (newline 1)))))
- (if (and dbl-space (not (> relative-depth 0)))
- (newline 1))
- (if (and (not (eobp))
- (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))
- (insert (concat (allout-make-topic-prefix opening-numbered t depth)
- " "))
- (setq end (1+ (point)))
-
- (allout-rebullet-heading (and offer-recent-bullet ref-bullet)
- depth nil nil t)
- (if (> relative-depth 0)
- (save-excursion (goto-char ref-topic)
- (allout-show-children)))
- (end-of-line)
+ (forward-line 1)))
+ (allout-end-of-current-line))
+
+ ;;(if doing-beginning (goto-char doing-beginning))
+ (if (not (bobp))
+ ;; We insert a newline char rather than using open-line to
+ ;; avoid rear-stickiness inheritence of read-only property.
+ (progn (if (and (not (> depth ref-depth))
+ (not before))
+ (open-line 1)
+ (if (and (not dbl-space) (> depth ref-depth))
+ (newline 1)
+ (if dbl-space
+ (open-line 1)
+ (if (not before)
+ (newline 1)))))
+ (if (and dbl-space (not (> relative-depth 0)))
+ (newline 1))
+ (if (and (not (eobp))
+ (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))
+ (insert (concat (allout-make-topic-prefix opening-numbered t depth)
+ " "))
+ (setq end (1+ (point)))
+
+ (allout-rebullet-heading (and offer-recent-bullet ref-bullet)
+ depth nil nil t)
+ (if (> relative-depth 0)
+ (save-excursion (goto-char ref-topic)
+ (allout-show-children)))
+ (end-of-line)
- (run-hook-with-args 'allout-structure-added-hook start end)
+ (run-hook-with-args 'allout-structure-added-hook start end)
+ )
)
)
;;;_ > allout-open-subtopic (arg)
(when (not allout-inhibit-auto-fill)
(let ((fill-prefix (if allout-use-hanging-indents
;; Check for topic header indentation:
- (save-excursion
- (beginning-of-line)
- (if (looking-at allout-regexp)
- ;; ... construct indentation to account for
- ;; length of topic prefix:
- (make-string (progn (allout-end-of-prefix)
- (current-column))
- ?\ )))))
+ (save-match-data
+ (save-excursion
+ (beginning-of-line)
+ (if (looking-at allout-regexp)
+ ;; ... construct indentation to account for
+ ;; length of topic prefix:
+ (make-string (progn (allout-end-of-prefix)
+ (current-column))
+ ?\ ))))))
(use-auto-fill-function (or allout-outside-normal-auto-fill-function
auto-fill-function
'do-auto-fill)))
(not (looking-at allout-regexp)))
(if (> 0 (setq excess (- (- old-indent-end old-indent-begin)
old-margin)))
- ;; Text starts left of old margin - don't adjust:
+ ;; Text starts left of old margin -- don't adjust:
nil
- ;; Text was hanging at or right of old left margin -
+ ;; Text was hanging at or right of old left margin --
;; reindent it, preserving its existing indentation
;; beyond the old margin:
(delete-region old-indent-begin old-indent-end)
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
(goto-char mb)
; Dispense with number if
; numbered-bullet prefix:
- (if (and allout-numbered-bullet
- (string= allout-numbered-bullet current-bullet)
- (looking-at "[0-9]+"))
- (allout-unprotected
- (delete-region (match-beginning 0)(match-end 0))))
+ (save-match-data
+ (if (and allout-numbered-bullet
+ (string= allout-numbered-bullet current-bullet)
+ (looking-at "[0-9]+"))
+ (allout-unprotected
+ (delete-region (match-beginning 0)(match-end 0)))))
;; convey 'allout-was-hidden annotation, if original had it:
(if has-annotation
Descends into invisible as well as visible topics, however.
-When optional sans-offspring is non-nil, subtopics are not
+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
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..)"
+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.
nil)))) ;;; do-successors
((< starting-depth new-depth)
- ;; Rare case - subtopic more than one level deeper than parent.
+ ;; Rare case -- subtopic more than one level deeper than parent.
;; Treat this one at an even deeper level:
(allout-rebullet-topic-grunt relative-depth
new-depth
(defun allout-number-siblings (&optional denumber)
"Assign numbered topic prefix to this topic and its siblings.
-With universal argument, denumber - assign default bullet to this
+With universal argument, denumber -- assign default bullet to this
topic and its siblings.
With repeated universal argument (`^U^U'), solicit bullet for each
(if (or (not (allout-mode-p))
(not (bolp))
- (not (looking-at allout-regexp)))
+ (not (save-match-data (looking-at allout-regexp))))
;; Just do a regular kill:
(kill-line arg)
;; Ah, have to watch out for adjustments:
(if allout-numbered-bullet
(save-excursion ; Renumber subsequent topics if needed:
- (if (not (looking-at allout-regexp))
+ (if (not (save-match-data (looking-at allout-regexp)))
(allout-next-heading))
(allout-renumber-to-depth depth)))
(run-hook-with-args 'allout-structure-deleted-hook depth (point)))))
previous one.
Topic exposure is marked with text-properties, to be used by
-allout-yank-processing for exposure recovery."
+`allout-yank-processing' for exposure recovery."
(interactive)
(let* ((inhibit-field-text-motion t)
(if (and (/= (current-column) 0) (not (eobp)))
(forward-char 1))
(if (not (eobp))
- (if (and (looking-at "\n")
+ (if (and (save-match-data (looking-at "\n"))
(or (save-excursion
(or (not (allout-next-heading))
(= depth allout-recent-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."
+ "Like `allout-kill-topic', but save to kill ring instead of deleting."
(interactive)
(let ((buffer-read-only t))
(condition-case nil
'invisible
nil end))))
(if (or (not next) (eq prev next))
- ;; still not at start of hidden area - must not be any left.
+ ;; still not at start of hidden area -- must not be any left.
(setq done t)
(goto-char next)
(setq prev next)
'allout-was-hidden
nil end)))
(if (or (not next) (eq prev next))
- ;; no more or not advancing - must not be any left.
+ ;; no more or not advancing -- must not be any left.
(setq done t)
(goto-char next)
(setq prev next)
(setq next (next-single-char-property-change (point)
'allout-was-hidden
nil end))
- (overlay-put (make-overlay prev next)
+ (overlay-put (make-overlay prev next nil 'front-advance)
'category 'allout-exposure-category)
(allout-deannotate-hidden prev next)
(setq prev next)
; region around subject:
(if (< (allout-mark-marker t) (point))
(exchange-point-and-mark))
- (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
+ (save-match-data
+ (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
- (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 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))))))
- ;; Preserve new bullet if it's a distinctive one, otherwise
- ;; use old one:
- (if (string-match (regexp-quote prefix-bullet)
- allout-distinctive-bullets-string)
+ (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))))))
+ ;; 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)
- (allout-unprotected
- (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:
- (allout-unprotected
- (progn
- (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")
+ (message "... reconciling numbers")
; ... and renumber, in case necessary:
- (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 ""))))
- (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)))
+ (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 ""))))
+ (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.
Adapts level of popped topics to level of fresh prefix.
-Note - prefix changes to distinctive bullets will stick, if followed
+Note -- prefix changes to distinctive bullets will stick, if followed
by pops to non-distinctive yanks. Bug..."
(interactive "*p")
(interactive)
(if (not allout-file-xref-bullet)
(error
- "Outline cross references disabled - no `allout-file-xref-bullet'")
+ "Outline cross references disabled -- no `allout-file-xref-bullet'")
(if (not (string= (allout-current-bullet) allout-file-xref-bullet))
(error "Current heading lacks cross-reference bullet `%s'"
allout-file-xref-bullet)
(let ((inhibit-field-text-motion t)
file-name)
- (save-excursion
- (let* ((text-start allout-recent-prefix-end)
- (heading-end (progn (end-of-line) (point))))
- (goto-char text-start)
- (setq file-name
- (if (re-search-forward "\\s-\\(\\S-*\\)" heading-end t)
- (buffer-substring (match-beginning 1) (match-end 1))))))
+ (save-match-data
+ (save-excursion
+ (let* ((text-start allout-recent-prefix-end)
+ (heading-end (progn (end-of-line) (point))))
+ (goto-char text-start)
+ (setq file-name
+ (if (re-search-forward "\\s-\\(\\S-*\\)" heading-end t)
+ (buffer-substring (match-beginning 1)
+ (match-end 1)))))))
(setq file-name (expand-file-name file-name))
(if (or (file-exists-p file-name)
(if (file-writable-p file-name)
;; We use outline invisibility spec.
(remove-overlays from to 'category 'allout-exposure-category)
(when flag
- (let ((o (make-overlay from to)))
+ (let ((o (make-overlay from to nil 'front-advance)))
(overlay-put o 'category 'allout-exposure-category)
(when (featurep 'xemacs)
(let ((props (symbol-plist 'allout-exposure-category)))
)))
;;;_ > 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)
- ;; Outside any topics - try to get to the first:
+ ;; Outside any topics -- try to get to the first:
(if (not (allout-next-heading))
(error "No topics")
- ;; got to first, outermost topic - set to expose it and siblings:
- (message "Above outermost topic - exposing all.")
+ ;; got to first, outermost topic -- set to expose it and siblings:
+ (message "Above outermost topic -- exposing all.")
(allout-flag-region (point-min)(point-max) nil))
(allout-beginning-of-current-line)
(if (not arg)
collapsed and uncollapsed. If optional INCLUDE-SINGLE-LINERS is
true, then single-line topics are considered to be collapsed. By
default, they are treated as being uncollapsed."
- (save-excursion
- (and
- ;; Is the topic all on one line (allowing for trailing blank line)?
- (>= (progn (allout-back-to-current-heading)
- (move-end-of-line 1)
- (point))
- (allout-end-of-current-subtree (not (looking-at "\n\n"))))
-
- (or include-single-liners
- (progn (backward-char 1) (allout-hidden-p))))))
+ (save-match-data
+ (save-excursion
+ (and
+ ;; Is the topic all on one line (allowing for trailing blank line)?
+ (>= (progn (allout-back-to-current-heading)
+ (move-end-of-line 1)
+ (point))
+ (allout-end-of-current-subtree (not (looking-at "\n\n"))))
+
+ (or include-single-liners
+ (progn (backward-char 1) (allout-hidden-p)))))))
;;;_ > allout-hide-current-subtree (&optional just-close)
(defun allout-hide-current-subtree (&optional just-close)
"Close the current topic, or containing topic if this one is already closed.
(interactive)
(let* ((from (point))
- (sibs-msg "Top-level topic already closed - closing siblings...")
+ (sibs-msg "Top-level topic already closed -- closing siblings...")
(current-exposed (not (allout-current-topic-collapsed-p t))))
(cond (current-exposed (allout-flag-current-subtree t))
(just-close nil)
(allout-expose-topic '(0 :))
(message (concat sibs-msg " Done."))))
(goto-char from)))
+;;;_ > allout-toggle-current-subtree-exposure
+(defun allout-toggle-current-subtree-exposure ()
+ "Show or hide the current subtree depending on its current state."
+ ;; thanks to tassilo for suggesting this.
+ (interactive)
+ (save-excursion
+ (allout-back-to-heading)
+ (if (allout-hidden-p (point-at-eol))
+ (allout-show-current-subtree)
+ (allout-hide-current-subtree))))
;;;_ > allout-show-current-branches ()
(defun allout-show-current-branches ()
"Show all subheadings of this heading, but not their bodies."
;;;_ > allout-hide-region-body (start end)
(defun allout-hide-region-body (start end)
"Hide all body lines in the region, but not headings."
- (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (goto-char (point-min))
- (let ((inhibit-field-text-motion t))
- (while (not (eobp))
- (end-of-line)
- (allout-flag-region (point) (allout-end-of-entry) t)
- (if (not (eobp))
- (forward-char
- (if (looking-at "\n\n")
- 2 1))))))))
+ (save-match-data
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (let ((inhibit-field-text-motion t))
+ (while (not (eobp))
+ (end-of-line)
+ (allout-flag-region (point) (allout-end-of-entry) t)
+ (if (not (eobp))
+ (forward-char
+ (if (looking-at "\n\n")
+ 2 1)))))))))
;;;_ > allout-expose-topic (spec)
(defun allout-expose-topic (spec)
that level.
- positive numbers open to the relative depth indicated by the
number, but do not force already opened subtopics to be closed.
- - 0 means to close topic - hide all offspring.
+ - 0 means to close topic -- hide all offspring.
: - `repeat'
apply prior element to all siblings at current level, *up to*
those siblings that would be covered by specs following the `:'
on the list. Ie, apply to all topics at level but the last
ones. (Only first of multiple colons at same level is
- respected - subsequent ones are discarded.)
+ respected -- subsequent ones are discarded.)
* - completely opens the topic, including bodies.
+ - shows all the sub headers, but not the bodies
- - exposes the body of the corresponding topic.
;; Expand the `repeat' spec to an explicit version,
;; w.r.t. remaining siblings:
(let ((residue ; = # of sibs not covered by remaining spec
- ;; Dang - could be nice to make use of the chart, sigh:
+ ;; Dang, could be nice to make use of the chart, sigh:
(- (length (allout-chart-siblings))
(length spec))))
(if (< 0 residue)
- ;; Some residue - cover it with prev-elem:
+ ;; Some residue -- cover it with prev-elem:
(setq spec (append (make-list residue prev-elem)
spec)))))))
((numberp curr-elem)
(error "allout-new-exposure: Can't find any outline topics"))
(list 'allout-expose-topic (list 'quote spec))))
-;;;_ #7 Systematic outline presentation - copying, printing, flattening
+;;;_ #7 Systematic outline presentation -- copying, printing, flattening
;;;_ - Mapping and processing of topics
;;;_ ( See also Subtree Charting, in Navigation code.)
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
+ 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
(beginning-of-line)
;; Goto initial topic, and register preceeding stuff, if any:
(if (> (allout-goto-prefix-doublechecked) start)
- ;; First topic follows beginning point - register preliminary stuff:
+ ;; First topic follows beginning point -- register preliminary stuff:
(setq result (list (list 0 "" nil
(buffer-substring start (1- (point)))))))
(while (and (not done)
(cond ((= new-depth depth)
(setq format (cons (1+ (car format))
(cdr format))))
- ((> new-depth depth) ; descending - assume by 1:
+ ((> new-depth depth) ; descending -- assume by 1:
(setq format (cons 1 format)))
(t
; Pop the residue:
(cdr format)))))))
;; Put the list with first at front, to last at back:
(nreverse result))))
-;;;_ > my-region-active-p ()
-(defmacro my-region-active-p ()
- (if (fboundp 'region-active-p)
- '(region-active-p)
- 'mark-active))
-;;;_ > allout-process-exposed (&optional func from to frombuf
+;;;_ > allout-region-active-p ()
+(defmacro allout-region-active-p ()
+ (cond ((fboundp 'use-region-p) '(use-region-p))
+ ((fboundp 'region-active-p) '(region-active-p))
+ (t 'mark-active)))
+;;_ > allout-process-exposed (&optional func from to frombuf
;;; tobuf format)
(defun allout-process-exposed (&optional func from to frombuf tobuf
format start-num)
FROMBUF to buffer TOBUF. Sixth optional arg, FORMAT, designates an
alternate presentation form:
- `flat' - Present prefix as numeric section.subsection..., starting with
- section indicated by the start-num, innermost nesting first.
- X`flat-indented' - Prefix is like `flat' for first topic at each
+ `flat' -- Present prefix as numeric section.subsection..., starting with
+ section indicated by the START-NUM, innermost nesting first.
+ X`flat-indented' -- Prefix is like `flat' for first topic at each
X level, but subsequent topics have only leaf topic
X number, padded with blanks to line up with first.
- `indent' (symbol) - Convert header prefixes to all white space,
+ `indent' (symbol) -- Convert header prefixes to all white space,
except for distinctive bullets.
Defaults:
; defaulting if necessary:
(if (not func) (setq func 'allout-insert-listified))
(if (not (and from to))
- (if (my-region-active-p)
+ (if (allout-region-active-p)
(setq from (region-beginning) to (region-end))
(setq from (point-min) to (point-max))))
(if frombuf
(if (not (bufferp frombuf))
- ;; Specified but not a buffer - get it:
+ ;; Specified but not a buffer -- get it:
(let ((got (get-buffer frombuf)))
(if (not got)
(error (concat "allout-process-exposed: source buffer "
frombuf
" not found."))
(setq frombuf got))))
- ;; not specified - default it:
+ ;; not specified -- default it:
(setq frombuf (current-buffer)))
(if tobuf
(if (not (bufferp tobuf))
(setq tobuf (get-buffer-create tobuf)))
- ;; not specified - default it:
+ ;; not specified -- default it:
(setq tobuf (concat "*" (buffer-name frombuf) " exposed*")))
(if (listp format)
(nreverse format))
(progn (set-buffer frombuf)
(allout-listify-exposed from to format))))
(set-buffer tobuf)
- (mapcar func listified)
+ (mapc func listified)
(pop-to-buffer tobuf)))
;;;_ - Copy exposed
(defun allout-flatten-exposed-to-buffer (&optional arg tobuf)
"Present numeric outline of outline's exposed portions in another buffer.
-The resulting outline is not compatible with outline mode - use
+The resulting outline is not compatible with outline mode -- use
`allout-copy-exposed-to-buffer' if you want that.
Use `allout-indented-exposed-to-buffer' for indented presentation.
(defun allout-indented-exposed-to-buffer (&optional arg tobuf)
"Present indented outline of outline's exposed portions in another buffer.
-The resulting outline is not compatible with outline mode - use
+The resulting outline is not compatible with outline mode -- use
`allout-copy-exposed-to-buffer' if you want that.
Use `allout-flatten-exposed-to-buffer' for numeric sectional presentation.
(let ((beg (point))
(end (progn (end-of-line)(point))))
(goto-char beg)
- (while (re-search-forward "\\\\"
- ;;"\\\\\\|\\{\\|\\}\\|\\_\\|\\$\\|\\\"\\|\\&\\|\\^\\|\\-\\|\\*\\|#"
- end ; bounded by end-of-line
- 1) ; no matches, move to end & return nil
- (goto-char (match-beginning 2))
- (insert "\\")
- (setq end (1+ end))
- (goto-char (1+ (match-end 2)))))))
+ (save-match-data
+ (while (re-search-forward "\\\\"
+ ;;"\\\\\\|\\{\\|\\}\\|\\_\\|\\$\\|\\\"\\|\\&\\|\\^\\|\\-\\|\\*\\|#"
+ end ; bounded by end-of-line
+ 1) ; no matches, move to end & return nil
+ (goto-char (match-beginning 2))
+ (insert "\\")
+ (setq end (1+ end))
+ (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."
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
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-one topics, with prefix consisting solely of an `*' asterisk, cannot be
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
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.
subtree-end))
(subtree-end-char (char-after (1- subtree-end)))
(subtree-trailing-char (char-after subtree-end))
- ;; kluge - result-text needs to be nil, but we also want to
+ ;; kluge -- result-text needs to be nil, but we also want to
;; check for the error condition
(result-text (if (or (string= "" subject-text)
(string= "\n" subject-text))
FETCH-PASS (default false) forces fresh prompting for the passphrase.
-KEY-TYPE indicates whether to use a 'symmetric or 'keypair cipher.
+KEY-TYPE, either `symmetric' or `keypair', specifies which type
+of cypher to use.
FOR-KEY is human readable identification of the first of the user's
eligible secret keys a keypair decryption targets, or else nil.
-Optional RETRIED is for internal use - conveys the number of failed keys
+Optional RETRIED is for internal use -- conveys the number of failed keys
that have been solicited in sequence leading to this current call.
Optional PASSPHRASE enables explicit delivery of the decryption passphrase,
for verification purposes.
-Optional REJECTED is for internal use - conveys the number of
+Optional REJECTED is for internal use -- conveys the number of
rejections due to matches against
`allout-encryption-ciphertext-rejection-regexps', as limited by
`allout-encryption-ciphertext-rejection-ceiling'.
(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
(let ((re (if (listp re) (car re) re))
(replacement (if (listp re) (cadr re) "")))
(goto-char (point-min))
- (while (re-search-forward re nil t)
- (replace-match replacement nil nil)))))
+ (save-match-data
+ (while (re-search-forward re nil t)
+ (replace-match replacement nil nil))))))
(cond
(if status
(pgg-situate-output (point-min) (point-max))
- ;; failed - handle passphrase caching
+ ;; failed -- handle passphrase caching
(if verifying
(throw 'encryption-failed nil)
(pgg-remove-passphrase-from-cache target-cache-id t)
- (error "Symmetric-cipher %scryption failed - %s"
+ (error "Symmetric-cipher %scryption failed -- %s"
(if decrypt "de" "en")
- "try again with different passphrase."))))
+ "try again with different passphrase"))))
- ;; encrypt 'keypair:
+ ;; encrypt `keypair':
((not decrypt)
(setq status
(error (pgg-remove-passphrase-from-cache target-cache-id t)
(error "encryption failed"))))
- ;; decrypt 'keypair:
+ ;; decrypt `keypair':
(t
(setq status
1 (- (point-max) (if decrypt 0 1))))
)
- ;; validate result - non-empty
+ ;; validate result -- non-empty
(cond ((not result-text)
(if verifying
nil
(string-match "[\C-a\C-k\C-o-\C-z\C-@]"
result-text))
(error (concat "Encryption produced non-armored text, which"
- "conflicts with allout mode - reconfigure!")))
+ "conflicts with allout mode -- reconfigure!")))
;; valid result and just verifying or non-symmetric:
((or verifying (not (equal key-type 'symmetric)))
passphrase t))
result-text)
- ;; valid result and regular symmetric - "register"
+ ;; valid result and regular symmetric -- "register"
;; passphrase with mnemonic aids/cache.
(t
(set-buffer allout-buffer)
PROMPT-ID is the id for use when prompting the user.
-KEY-TYPE is either 'symmetric or 'keypair.
+KEY-TYPE is either `symmetric' or `keypair'.
ALLOUT-BUFFER is the buffer containing the entry being en/decrypted.
(if (and (not confirmation)
(if (yes-or-no-p
(concat "Passphrase differs from established"
- " - use new one instead? "))
+ " -- use new one instead? "))
;; deactivate password for subsequent
;; confirmation:
(progn
t))
(progn (pgg-remove-passphrase-from-cache cache-id t)
(error "Wrong passphrase."))))
- ;; No verifier string - force confirmation by repetition of
+ ;; No verifier string -- force confirmation by repetition of
;; (new) passphrase:
((or fetch-pass (not cached))
(pgg-remove-passphrase-from-cache cache-id t))))
- ;; confirmation vs new input - doing pgg-read-passphrase will do the
+ ;; confirmation vs new input -- doing pgg-read-passphrase will do the
;; right thing, in either case:
(if (not confirmation)
(setq confirmation
(if (equal got-pass confirmation)
confirmation
(if (yes-or-no-p (concat "spelling of original and"
- " confirmation differ - retry? "))
+ " confirmation differ -- retry? "))
(progn (setq retried (if retried (1+ retried) 1))
(pgg-remove-passphrase-from-cache cache-id t)
;; recurse to this routine:
(allout-end-of-prefix t)
(and (string= (buffer-substring-no-properties (1- (point)) (point))
allout-topic-encryption-bullet)
- (looking-at "\\*"))
+ (save-match-data (looking-at "\\*")))
)
)
;;;_ > allout-encrypted-key-info (text)
(defun allout-encrypted-key-info (text)
"Return a pair of the key type and identity of a recipient's secret key.
-The key type is one of 'symmetric or 'keypair.
+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)
- (while (not done)
-
- (if (not (re-search-forward
- (format "\\(\\`\\|\n\\)%s *%s[^*]"
- (regexp-quote allout-header-prefix)
- (regexp-quote allout-topic-encryption-bullet))
- nil t))
- (setq got nil
- done t)
- (goto-char (setq got (match-beginning 0)))
- (if (looking-at "\n")
- (forward-char 1))
- (setq got (point)))
-
- (cond ((not got)
- (setq done t))
-
- ((not (search-forward "\n"))
- (setq got nil
- done t))
-
- ((eobp)
- (setq got nil
- done t))
+ (save-match-data
+ (while (not done)
- (t
- (setq content-beg (point))
- (backward-char 1)
- (allout-end-of-subtree)
- (if (or (<= (point) content-beg)
- (and except-mark
- (<= content-beg except-mark)
- (>= (point) except-mark)))
- ;; Continue looking
- (setq got nil)
- ;; Got it!
- (setq done t)))
- )
+ (if (not (re-search-forward
+ (format "\\(\\`\\|\n\\)%s *%s[^*]"
+ (regexp-quote allout-header-prefix)
+ (regexp-quote allout-topic-encryption-bullet))
+ nil t))
+ (setq got nil
+ done t)
+ (goto-char (setq got (match-beginning 0)))
+ (if (save-match-data (looking-at "\n"))
+ (forward-char 1))
+ (setq got (point)))
+
+ (cond ((not got)
+ (setq done t))
+
+ ((not (search-forward "\n"))
+ (setq got nil
+ done t))
+
+ ((eobp)
+ (setq got nil
+ done t))
+
+ (t
+ (setq content-beg (point))
+ (backward-char 1)
+ (allout-end-of-subtree)
+ (if (or (<= (point) content-beg)
+ (and except-mark
+ (<= content-beg except-mark)
+ (>= (point) except-mark)))
+ ;; Continue looking
+ (setq got nil)
+ ;; Got it!
+ (setq done t)))
+ )
+ )
+ (if got
+ (goto-char got))
)
- (if got
- (goto-char got))
)
)
;;;_ > allout-encrypt-decrypted (&optional except-mark)
"Encrypt topics pending encryption except those containing exemption point.
EXCEPT-MARK identifies a point whose containing topics should be excluded
-from encryption. This supports 'except-current mode of
+from encryption. This supports the `except-current' mode of
`allout-encrypt-unencrypted-on-saves'.
If a topic that is currently being edited was encrypted, we return a list
save. See `allout-encrypt-unencrypted-on-saves' for more info."
(interactive "p")
- (save-excursion
- (let* ((current-mark (point-marker))
- (current-mark-position (marker-position current-mark))
- was-modified
- bo-subtree
- editing-topic editing-point)
- (goto-char (point-min))
- (while (allout-next-topic-pending-encryption except-mark)
- (setq was-modified (buffer-modified-p))
- (when (save-excursion
- (and (boundp 'allout-encrypt-unencrypted-on-saves)
- allout-encrypt-unencrypted-on-saves
- (setq bo-subtree (re-search-forward "$"))
- (not (allout-hidden-p))
- (>= current-mark (point))
- (allout-end-of-current-subtree)
- (<= current-mark (point))))
+ (save-match-data
+ (save-excursion
+ (let* ((current-mark (point-marker))
+ (current-mark-position (marker-position current-mark))
+ was-modified
+ bo-subtree
+ editing-topic editing-point)
+ (goto-char (point-min))
+ (while (allout-next-topic-pending-encryption except-mark)
+ (setq was-modified (buffer-modified-p))
+ (when (save-excursion
+ (and (boundp 'allout-encrypt-unencrypted-on-saves)
+ allout-encrypt-unencrypted-on-saves
+ (setq bo-subtree (re-search-forward "$"))
+ (not (allout-hidden-p))
+ (>= current-mark (point))
+ (allout-end-of-current-subtree)
+ (<= current-mark (point))))
(setq editing-topic (point)
;; we had to wait for this 'til now so prior topics are
;; encrypted, any relevant text shifts are in place:
editing-point (- current-mark-position
(count-trailing-whitespace-region
bo-subtree current-mark-position))))
- (allout-toggle-subtree-encryption)
+ (allout-toggle-subtree-encryption)
+ (if (not was-modified)
+ (set-buffer-modified-p nil))
+ )
(if (not was-modified)
(set-buffer-modified-p nil))
+ (if editing-topic (list editing-topic editing-point))
)
- (if (not was-modified)
- (set-buffer-modified-p nil))
- (if editing-topic (list editing-topic editing-point))
)
)
)
(if (allout-goto-prefix)
t
(allout-open-topic 2)
- (insert (concat "Dummy outline topic header - see"
+ (insert (concat "Dummy outline topic header -- see"
"`allout-mode' docstring: `^Hm'."))
(allout-adjust-file-variable
"allout-layout" (or allout-layout '(-1 : 0))))))
(defun allout-file-vars-section-data ()
"Return data identifying the file-vars section, or nil if none.
-Returns list `(beginning-point prefix-string suffix-string)'."
+Returns a list of the form (BEGINNING-POINT PREFIX-STRING SUFFIX-STRING)."
;; minimally gleaned from emacs 21.4 files.el hack-local-variables function.
(let (beg prefix suffix)
(save-excursion
got)
(dolist (sym configvar-value)
(if (not (boundp sym))
- (if (yes-or-no-p (format "%s entry `%s' is unbound - remove it? "
+ (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)))
string
""))
nil))))
- ;; got something out of loop - return it:
+ ;; got something out of loop -- return it:
got)
)
;;;_ : Strings:
(defun regexp-sans-escapes (regexp &optional successive-backslashes)
"Return a copy of REGEXP with all character escapes stripped out.
-Representations of actual backslashes - '\\\\\\\\' - are left as a
+Representations of actual backslashes -- '\\\\\\\\' -- are left as a
single backslash.
Optional arg SUCCESSIVE-BACKSLASHES is used internally for recursion."
If BEG is bigger than END we return 0."
(if (> beg end)
0
- (save-excursion
- (goto-char beg)
- (let ((count 0))
- (while (re-search-forward "[ ][ ]*$" end t)
- (goto-char (1+ (match-beginning 2)))
- (setq count (1+ count)))
- count))))
+ (save-match-data
+ (save-excursion
+ (goto-char beg)
+ (let ((count 0))
+ (while (re-search-forward "[ ][ ]*$" end t)
+ (goto-char (1+ (match-beginning 2)))
+ (setq count (1+ count)))
+ count)))))
;;;_ > allout-format-quote (string)
(defun allout-format-quote (string)
"Return a copy of string with all \"%\" characters doubled."
(cond ((null list) nil)
((atom (car list)) (cons (car list) (allout-flatten (cdr list))))
(t (append (allout-flatten (car list)) (allout-flatten (cdr list))))))
-;;;_ : Compatability:
+;;;_ : Compatibility:
;;;_ > allout-mark-marker to accommodate divergent emacsen:
(defun allout-mark-marker (&optional force buffer)
"Accommodate the different signature for `mark-marker' across Emacsen.
(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.
;; Move to beginning-of-line, ignoring fields and invisibles.
(skip-chars-backward "^\n")
- (while (and (not (bobp)) (line-move-invisible-p (1- (point))))
+ (while (and (not (bobp))
+ (let ((prop
+ (get-char-property (1- (point)) 'invisible)))
+ (if (eq buffer-invisibility-spec t)
+ prop
+ (or (memq prop buffer-invisibility-spec)
+ (assq prop buffer-invisibility-spec)))))
(goto-char (if (featurep 'xemacs)
(previous-property-change (point))
(previous-char-property-change (point))))
(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.
(error nil))
(not (bobp))
(progn
- (while (and (not (bobp))
- (line-move-invisible-p (1- (point))))
+ (while
+ (and
+ (not (bobp))
+ (let ((prop
+ (get-char-property (1- (point))
+ 'invisible)))
+ (if (eq buffer-invisibility-spec t)
+ prop
+ (or (memq prop
+ buffer-invisibility-spec)
+ (assq prop
+ buffer-invisibility-spec)))))
(goto-char
(previous-char-property-change (point))))
(backward-char 1)))
(setq arg 1)
(setq done t)))))))
)
-;;;_ > 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."
- (let ((prop
- (get-char-property pos 'invisible)))
- (if (eq buffer-invisibility-spec t)
- prop
- (or (memq prop buffer-invisibility-spec)
- (assq prop buffer-invisibility-spec))))))
;;;_ #10 Unfinished
;;;_ > allout-bullet-isearch (&optional bullet)
(isearch-repeat 'forward)
(isearch-mode t)))
-;;;_ #11 Unit tests - this should be last item before "Provide"
+;;;_ #11 Unit tests -- this should be last item before "Provide"
;;;_ > allout-run-unit-tests ()
(defun allout-run-unit-tests ()
"Run the various allout unit tests."
(while (boundp name) (makunbound name)))
;;;_ > allout-test-resumptions ()
(defvar allout-tests-globally-unbound nil
- "Fodder for allout resumptions tests - defvar just for byte compiler.")
+ "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.")
+ "Fodder for allout resumptions tests -- defvar just for byte compiler.")
(defun allout-test-resumptions ()
"Exercise allout resumptions."
;; for each resumption case, we also test that the right local/global
(allout-tests-obliterate-variable 'allout-tests-locally-true)
(set (make-local-variable 'allout-tests-locally-true) t)
(assert (not (default-boundp 'allout-tests-locally-true))
- nil (concat "Test setup mistake - variable supposed to"
+ nil (concat "Test setup mistake -- variable supposed to"
" not have global binding, but it does."))
(assert (local-variable-p 'allout-tests-locally-true)
- nil (concat "Test setup mistake - variable supposed to have"
+ nil (concat "Test setup mistake -- variable supposed to have"
" local binding, but it lacks one."))
(allout-add-resumptions '(allout-tests-locally-true nil))
(assert (not (default-boundp 'allout-tests-locally-true)))
HCoop / bpt / emacs.git / blobdiff