;;; allout.el --- extensive outline mode for use alone and with other modes
-;; Copyright (C) 1992, 1993, 1994, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1993, 1994, 2001, 2002, 2003, 2004, 2005, 2006,
+;; 2007, 2008, 2009, 2010, 2011 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
-;; Version: 2.2.1
+;; Version: 2.3
;; Keywords: outlines wp languages
;; Website: http://myriadicity.net/Sundry/EmacsAllout
;; - 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.
-;; Currently only GnuPG encryption is supported, and integration
-;; with gpg-agent is not yet implemented.)
+;; maintenance. Encryption is via the Emacs 'epg' library. See
+;; allout-toggle-current-subtree-encryption docstring.
;; - Automatic topic-number maintenance
;; - "Hot-spot" operation, for single-keystroke maneuvering and
;; exposure control (see the allout-mode docstring)
;;;_* Dependency autoloads
(require 'overlay)
(eval-when-compile
- ;; Most of the requires here are for stuff covered by autoloads.
- ;; Since just byte-compiling doesn't trigger autoloads, so that
- ;; "function not found" warnings would occur without these requires.
- (progn
- (require 'pgg)
- (require 'pgg-gpg)
- (require 'overlay)
- ;; `cl' is required for `assert'. `assert' is not covered by a standard
- ;; autoload, but it is a macro, so that eval-when-compile is sufficient
- ;; to byte-compile it in, or to do the require when the buffer evalled.
- (require 'cl)
- ))
+ ;; Most of the requires here are for stuff covered by autoloads, which
+ ;; byte-compiling doesn't trigger.
+ (require 'epg)
+ (require 'epa)
+ (require 'overlay)
+ ;; `cl' is required for `assert'. `assert' is not covered by a standard
+ ;; autoload, but it is a macro, so that eval-when-compile is sufficient
+ ;; to byte-compile it in, or to do the require when the buffer evalled.
+ (require 'cl)
+ )
;;;_* USER CUSTOMIZATION VARIABLES:
-;;;_ > defgroup allout
+;;;_ > defgroup allout, allout-keybindings
(defgroup allout nil
"Extensive outline mode for use alone and with other modes."
:prefix "allout-"
:group 'outlines)
+(defgroup allout-keybindings nil
+ "Allout outline mode keyboard bindings configuration."
+ :group 'allout)
;;;_ + Layout, Mode, and Topic Header Configuration
-;;;_ = allout-command-prefix
+(defvar allout-command-prefix) ; defined below
+
+;;;_ > allout-keybindings incidentals:
+;;;_ : internal key binding stuff - in this section for load-order.
+;;;_ = allout-mode-map
+(defvar allout-mode-map 'allout-mode-map
+ "Keybindings place-holder for (allout) outline minor mode.
+
+Do NOT set the value of this variable. Instead, customize
+`allout-command-prefix', `allout-prefixed-keybindings', and
+`allout-unprefixed-keybindings'.")
+;;;_ = allout-mode-map-value
+(defvar allout-mode-map-value nil
+ "Keymap for allout outline minor mode.
+
+Do NOT set the value of this variable. Instead, customize
+`allout-command-prefix', `allout-prefixed-keybindings', and
+`allout-unprefixed-keybindings'.")
+;;;_ = make allout-mode-map-value an alias for allout-mode-map:
+;; this needs to be revised when the value is changed, sigh.
+(defalias 'allout-mode-map allout-mode-map-value)
+;;;_ > allout-compose-and-institute-keymap (&optional varname value)
+(defun allout-compose-and-institute-keymap (&optional varname value)
+ "Create the allout keymap according to the keybinding specs, and set it.
+
+Useful standalone or to effect customizations of the
+respective allout-mode keybinding variables, `allout-command-prefix',
+`allout-prefixed-keybindings', and `allout-unprefixed-keybindings'"
+ ;; Set the customization variable, if any:
+ (when varname
+ (set-default varname value))
+ (let ((map (make-sparse-keymap)))
+ (when (boundp 'allout-prefixed-keybindings)
+ ;; tolerate first definitions of the variables:
+ (dolist (entry allout-prefixed-keybindings)
+ (define-key map
+ ;; XXX vector vs non-vector key descriptions?
+ (vconcat allout-command-prefix
+ (car (read-from-string (car entry))))
+ (cadr entry))))
+ (when (boundp 'allout-unprefixed-keybindings)
+ (dolist (entry allout-unprefixed-keybindings)
+ (define-key map (car (read-from-string (car entry))) (cadr entry))))
+ (substitute-key-definition 'beginning-of-line 'allout-beginning-of-line
+ map global-map)
+ (substitute-key-definition 'move-beginning-of-line 'allout-beginning-of-line
+ map global-map)
+ (substitute-key-definition 'end-of-line 'allout-end-of-line
+ map global-map)
+ (substitute-key-definition 'move-end-of-line 'allout-end-of-line
+ map global-map)
+ (allout-institute-keymap map)))
+;;;_ > allout-institute-keymap (map)
+(defun allout-institute-keymap (map)
+ "Associate allout-mode bindings with allout as a minor mode."
+ ;; Architecture:
+ ;; allout-mode-map var is a keymap by virtue of being a defalias for
+ ;; allout-mode-map-value, which has the actual keymap value.
+ ;; allout-mode-map's symbol value is just 'allout-mode-map, so it can be
+ ;; used in minor-mode-map-alist to indirect to the actual
+ ;; allout-mode-map-var value, which can be adjusted and reassigned.
+
+ (setq allout-mode-map-value map)
+ ;; The defalias reexecution is necessary when allout-mode-map-value is
+ ;; changing from nil, and it doesn't hurt to do it every time, so:
+ (defalias 'allout-mode-map allout-mode-map-value))
+;;;_ * intialize the mode map:
+;; ensure that allout-mode-map has some setting even if allout-mode hasn't
+;; been invoked:
+(allout-compose-and-institute-keymap)
+;;;_ = allout-command-prefix
(defcustom allout-command-prefix "\C-c "
- "*Key sequence to be used as prefix for outline mode command key bindings.
+ "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)))
+ :group 'allout-keybindings
+ :set 'allout-compose-and-institute-keymap)
+;;;_ = allout-keybindings-binding
+(define-widget 'allout-keybindings-binding 'lazy
+ "Structure of allout keybindings customization items."
+ :type '(repeat
+ (list (string :tag "Key" :value "[(meta control shift ?f)]")
+ (function :tag "Function name"
+ :value allout-forward-current-level))))
+;;;_ = allout-prefixed-keybindings
+(defcustom allout-prefixed-keybindings
+ '(("[(control ?n)]" allout-next-visible-heading)
+ ("[(control ?p)]" allout-previous-visible-heading)
+ ("[(control ?u)]" allout-up-current-level)
+ ("[(control ?f)]" allout-forward-current-level)
+ ("[(control ?b)]" allout-backward-current-level)
+ ("[(control ?a)]" allout-beginning-of-current-entry)
+ ("[(control ?e)]" allout-end-of-entry)
+ ("[(control ?i)]" allout-show-children)
+ ("[(control ?i)]" allout-show-children)
+ ("[(control ?s)]" allout-show-current-subtree)
+ ("[(control ?t)]" allout-toggle-current-subtree-exposure)
+;; Let user customize if they want to preempt describe-prefix-bindings ^h use.
+;; ("[(control ?h)]" allout-hide-current-subtree)
+ ("[?h]" allout-hide-current-subtree)
+ ("[(control ?o)]" allout-show-current-entry)
+ ("[?!]" allout-show-all)
+ ("[?x]" allout-toggle-current-subtree-encryption)
+ ("[? ]" allout-open-sibtopic)
+ ("[?.]" allout-open-subtopic)
+ ("[?,]" allout-open-supertopic)
+ ("[?']" allout-shift-in)
+ ("[?>]" allout-shift-in)
+ ("[?<]" allout-shift-out)
+ ("[(control ?m)]" allout-rebullet-topic)
+ ("[?*]" allout-rebullet-current-heading)
+ ("[?']" allout-number-siblings)
+ ("[(control ?k)]" allout-kill-topic)
+ ("[(meta ?k)]" allout-copy-topic-as-kill)
+ ("[?@]" 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-mode key bindings that are prefixed with `allout-command-prefix'.
+
+See `allout-unprefixed-keybindings' for the list of keybindings
+that are not prefixed.
+
+Use vector format for the keys:
+ - put literal keys after a '?' question mark, eg: '?a', '?.'
+ - enclose control, shift, or meta-modified keys as sequences within
+ parentheses, with the literal key, as above, preceded by the name(s)
+ of the modifers, eg: [(control ?a)]
+See the existing keys for examples.
+
+Functions can be bound to multiple keys, but binding keys to
+multiple functions will not work - the last binding for a key
+prevails."
+ :type 'allout-keybindings-binding
+ :group 'allout-keybindings
+ :set 'allout-compose-and-institute-keymap
+ )
+;;;_ = allout-unprefixed-keybindings
+(defcustom allout-unprefixed-keybindings
+ '(("[(control ?k)]" allout-kill-line)
+ ("[(meta ?k)]" allout-copy-line-as-kill)
+ ("[(control ?y)]" allout-yank)
+ ("[(meta ?y)]" allout-yank-pop)
+ )
+ "Allout-mode functions bound to keys without any added prefix.
+
+This is in contrast to the majority of allout-mode bindings on
+`allout-prefixed-bindings', whose bindings are created with a
+preceeding command key.
+
+Use vector format for the keys:
+ - put literal keys after a '?' question mark, eg: '?a', '?.'
+ - enclose control, shift, or meta-modified keys as sequences within
+ parentheses, with the literal key, as above, preceded by the name(s)
+ of the modifers, eg: [(control ?a)]
+See the existing keys for examples."
+ :type 'allout-keybindings-binding
+ :group 'allout-keybindings
+ :set 'allout-compose-and-institute-keymap
+ )
;;;_ = 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
:group 'allout)
;;;_ = allout-default-layout
(defcustom allout-default-layout '(-2 : 0)
- "*Default allout outline layout specification.
+ "Default allout outline layout specification.
This setting specifies the outline exposure to use when
`allout-layout' has the local value `t'. This docstring describes the
;;;_ = allout-inhibit-auto-fill
(defcustom allout-inhibit-auto-fill nil
- "*If non-nil, auto-fill will be inhibited in the allout buffers.
+ "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
(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.
+ "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."
;;;_ = 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.
+ "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
;;;_ = allout-show-bodies
(defcustom allout-show-bodies nil
- "*If non-nil, show entire body when exposing a topic, rather than
+ "If non-nil, show entire body when exposing a topic, rather than
just the header."
:type 'boolean
:group 'allout)
;;;_ = allout-beginning-of-line-cycles
(defcustom allout-beginning-of-line-cycles t
- "*If non-nil, \\[allout-beginning-of-line] will cycle through smart-placement options.
+ "If non-nil, \\[allout-beginning-of-line] will cycle through smart-placement options.
Cycling only happens on when the command is repeated, not when it
follows a different command.
:type 'boolean :group 'allout)
;;;_ = allout-end-of-line-cycles
(defcustom allout-end-of-line-cycles t
- "*If non-nil, \\[allout-end-of-line] will cycle through smart-placement options.
+ "If non-nil, \\[allout-end-of-line] will cycle through smart-placement options.
Cycling only happens on when the command is repeated, not when it
follows a different command.
(defcustom allout-header-prefix "."
;; this string is treated as literal match. it will be `regexp-quote'd, so
;; one cannot use regular expressions to match varying header prefixes.
- "*Leading string which helps distinguish topic headers.
+ "Leading string which helps distinguish topic headers.
Outline topic header lines are identified by a leading topic
header prefix, which mostly have the value of this var at their front.
(put 'allout-primary-bullet 'safe-local-variable 'stringp)
;;;_ = allout-plain-bullets-string
(defcustom allout-plain-bullets-string ".,"
- "*The bullets normally used in outline topic prefixes.
+ "The bullets normally used in outline topic prefixes.
See `allout-distinctive-bullets-string' for the other kind of
bullets.
(put 'allout-plain-bullets-string 'safe-local-variable 'stringp)
;;;_ = allout-distinctive-bullets-string
(defcustom allout-distinctive-bullets-string "*+-=>()[{}&!?#%\"X@$~_\\:;^"
- "*Persistent outline header bullets used to distinguish special topics.
+ "Persistent outline header bullets used to distinguish special topics.
These bullets are distinguish topics with particular character.
They are not used by default in the topic creation routines, but
`!' - 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
+ `=' - equal sign -- an assignment, some kind of definition
`^' - carat -- relates to something above
Some are more elusive, but their rationale may be recognizable:
;;;_ = allout-use-mode-specific-leader
(defcustom allout-use-mode-specific-leader t
- "*When non-nil, use mode-specific topic-header prefixes.
+ "When non-nil, use mode-specific topic-header prefixes.
Allout outline mode will use the mode-specific `allout-mode-leaders' or
comment-start string, if any, to lead the topic prefix string, so topic
;;;_ = allout-old-style-prefixes
(defcustom allout-old-style-prefixes nil
- "*When non-nil, use only old-and-crusty `outline-mode' `*' topic prefixes.
+ "When non-nil, use only old-and-crusty `outline-mode' `*' topic prefixes.
Non-nil restricts the topic creation and modification
functions to asterix-padded prefixes, so they look exactly
(if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil)))))
;;;_ = allout-stylish-prefixes -- alternating bullets
(defcustom allout-stylish-prefixes t
- "*Do fancy stuff with topic prefix bullets according to level, etc.
+ "Do fancy stuff with topic prefix bullets according to level, etc.
Non-nil enables topic creation, modification, and repositioning
functions to vary the topic bullet char (the char that marks the topic
;;;_ = allout-numbered-bullet
(defcustom allout-numbered-bullet "#"
- "*String designating bullet of topics that have auto-numbering; nil for none.
+ "String designating bullet of topics that have auto-numbering; nil for none.
Topics having this bullet have automatic maintenance of a sibling
sequence-number tacked on, just after the bullet. Conventionally set
'(lambda (x) (or (stringp x) (null x)))))
;;;_ = allout-file-xref-bullet
(defcustom allout-file-xref-bullet "@"
- "*Bullet signifying file cross-references, for `allout-resolve-xref'.
+ "Bullet signifying file cross-references, for `allout-resolve-xref'.
Set this var to the bullet you want to use for file cross-references."
:type '(choice (const nil) string)
'(lambda (x) (or (stringp x) (null x)))))
;;;_ = allout-presentation-padding
(defcustom allout-presentation-padding 2
- "*Presentation-format white-space padding factor, for greater indent."
+ "Presentation-format white-space padding factor, for greater indent."
:type 'integer
:group 'allout)
;;;_ = allout-abbreviate-flattened-numbering
(defcustom allout-abbreviate-flattened-numbering nil
- "*If non-nil, `allout-flatten-exposed-to-buffer' abbreviates topic
+ "If non-nil, `allout-flatten-exposed-to-buffer' abbreviates topic
numbers to minimal amount with some context. Otherwise, entire
numbers are always used."
:type 'boolean
;;;_ + LaTeX formatting
;;;_ - allout-number-pages
(defcustom allout-number-pages nil
- "*Non-nil turns on page numbering for LaTeX formatting of an outline."
+ "Non-nil turns on page numbering for LaTeX formatting of an outline."
:type 'boolean
:group 'allout)
;;;_ - allout-label-style
(defcustom allout-label-style "\\large\\bf"
- "*Font and size of labels for LaTeX formatting of an outline."
+ "Font and size of labels for LaTeX formatting of an outline."
:type 'string
:group 'allout)
;;;_ - allout-head-line-style
(defcustom allout-head-line-style "\\large\\sl "
- "*Font and size of entries for LaTeX formatting of an outline."
+ "Font and size of entries for LaTeX formatting of an outline."
:type 'string
:group 'allout)
;;;_ - allout-body-line-style
(defcustom allout-body-line-style " "
- "*Font and size of entries for LaTeX formatting of an outline."
+ "Font and size of entries for LaTeX formatting of an outline."
:type 'string
:group 'allout)
;;;_ - allout-title-style
(defcustom allout-title-style "\\Large\\bf"
- "*Font and size of titles for LaTeX formatting of an outline."
+ "Font and size of titles for LaTeX formatting of an outline."
:type 'string
:group 'allout)
;;;_ - allout-title
(defcustom allout-title '(or buffer-file-name (buffer-name))
- "*Expression to be evaluated to determine the title for LaTeX
+ "Expression to be evaluated to determine the title for LaTeX
formatted copy."
:type 'sexp
:group 'allout)
;;;_ - allout-line-skip
(defcustom allout-line-skip ".05cm"
- "*Space between lines for LaTeX formatting of an outline."
+ "Space between lines for LaTeX formatting of an outline."
:type 'string
:group 'allout)
;;;_ - allout-indent
(defcustom allout-indent ".3cm"
- "*LaTeX formatted depth-indent spacing."
+ "LaTeX formatted depth-indent spacing."
:type 'string
:group 'allout)
:group 'allout)
;;;_ = allout-topic-encryption-bullet
(defcustom allout-topic-encryption-bullet "~"
- "*Bullet signifying encryption of the entry's body."
+ "Bullet signifying encryption of the entry's body."
:type '(choice (const nil) string)
:version "22.1"
:group 'allout-encryption)
-;;;_ = allout-passphrase-verifier-handling
-(defcustom allout-passphrase-verifier-handling t
- "*Enable use of symmetric encryption passphrase verifier if non-nil.
-
-See the docstring for the `allout-enable-file-variable-adjustment'
-variable for details about allout ajustment of file variables."
- :type 'boolean
- :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
-
-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.1"
- :group 'allout-encryption)
-(make-variable-buffer-local 'allout-passphrase-hint-handling)
;;;_ = allout-encrypt-unencrypted-on-saves
(defcustom allout-encrypt-unencrypted-on-saves t
- "*When saving, should topics pending encryption be encrypted?
+ "When saving, should topics pending encryption be encrypted?
The idea is to prevent file-system exposure of any un-encrypted stuff, and
mostly covers both deliberate file writes and auto-saves.
;;;_ + Developer
;;;_ = allout-developer group
(defgroup allout-developer nil
- "Settings for topic encryption features of allout outliner."
+ "Allout settings developers care about, including topic encryption and more."
:group 'allout)
;;;_ = allout-run-unit-tests-on-load
(defcustom allout-run-unit-tests-on-load nil
- "*When non-nil, unit tests will be run at end of loading the allout module.
+ "When non-nil, unit tests will be run at end of loading the allout module.
Generally, allout code developers are the only ones who'll want to set this.
;;;_ = 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.
+ "If non-nil, some allout outline actions edit Emacs local file var text.
This can range from changes to existing entries, addition of new ones,
and creation of a new local variables section when necessary.
;;;_ #1 Internal Outline Formatting and Configuration
;;;_ : Version
;;;_ = allout-version
-(defvar allout-version "2.2.1"
+(defvar allout-version "2.3"
"Version of currently loaded outline package. (allout.el)")
;;;_ > allout-version
(defun allout-version (&optional here)
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."
+ "Reset the leading string used to identify topic headers."
(interactive "sNew lead string: ")
(setq allout-header-prefix header-lead)
(setq allout-header-subtraction (1- (length allout-header-prefix)))
(set-allout-regexp))
;;;_ X allout-lead-with-comment-string (header-lead)
(defun allout-lead-with-comment-string (&optional header-lead)
- "*Set the topic-header leading string to specified string.
+ "Set the topic-header leading string to specified string.
Useful when for encapsulating outline structure in programming
language comments. Returns the leading string."
"[^" allout-primary-bullet "]"))
"\\)"
))))
-;;;_ : Key bindings
-;;;_ = allout-mode-map
-(defvar allout-mode-map nil "Keybindings for (allout) outline minor mode.")
-;;;_ > produce-allout-mode-map (keymap-alist &optional base-map)
-(defun produce-allout-mode-map (keymap-list &optional base-map)
- "Produce keymap for use as `allout-mode-map', from KEYMAP-LIST.
-
-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."
- (let ((map (or base-map (make-sparse-keymap)))
- (pref (list allout-command-prefix)))
- (mapc (function
- (lambda (cell)
- (let ((add-pref (null (cdr (cdr cell))))
- (key-suff (list (car cell))))
- (apply 'define-key
- (list map
- (apply 'vconcat (if add-pref
- (append pref key-suff)
- key-suff))
- (car (cdr cell)))))))
- keymap-list)
- map))
;;;_ : Menu bar
(defvar allout-mode-exposure-menu)
(defvar allout-mode-editing-menu)
(defun produce-allout-mode-menubar-entries ()
(require 'easymenu)
(easy-menu-define allout-mode-exposure-menu
- allout-mode-map
+ allout-mode-map-value
"Allout outline exposure menu."
'("Exposure"
["Show Entry" allout-show-current-entry t]
"----"
["Show All" allout-show-all t]))
(easy-menu-define allout-mode-editing-menu
- allout-mode-map
+ allout-mode-map-value
"Allout outline editing menu."
'("Headings"
["Open Sibling" allout-open-sibtopic t]
allout-toggle-current-subtree-encryption
(> (allout-current-depth) 1)]))
(easy-menu-define allout-mode-navigation-menu
- allout-mode-map
+ allout-mode-map-value
"Allout outline navigation menu."
'("Navigation"
["Next Visible Heading" allout-next-visible-heading t]
["End of Entry" allout-end-of-entry t]
["End of Subtree" allout-end-of-current-subtree t]))
(easy-menu-define allout-mode-misc-menu
- allout-mode-map
+ allout-mode-map-value
"Allout outlines miscellaneous bindings."
'("Misc"
["Version" allout-version t]
(void-variable nil)))
(when (not (assoc name allout-mode-prior-settings))
;; Not already added as a resumption, create the prior setting entry.
- (if (local-variable-p name)
+ (if (local-variable-p name (current-buffer))
;; 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
;;;_ = allout-mode-deactivate-hook
(defvar allout-mode-deactivate-hook nil
"*Hook that's run when allout mode ends.")
+(define-obsolete-variable-alias 'allout-mode-deactivate-hook
+ 'allout-mode-off-hook "future")
;;;_ = allout-exposure-category
(defvar allout-exposure-category nil
"Symbol for use as allout invisible-text overlay category.")
-;;;_ x allout-view-change-hook
-(defvar allout-view-change-hook nil
- "*(Deprecated) A hook run after allout outline exposure changes.
-
-Switch to using `allout-exposure-change-hook' instead. Both hooks are
-currently respected, but the other conveys the details of the exposure
-change via explicit parameters, and this one will eventually be disabled in
-a subsequent allout version.")
;;;_ = allout-exposure-change-hook
(defvar allout-exposure-change-hook nil
"*Hook that's run after allout outline subtree exposure changes.
- 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.
-
-This hook is replacing `allout-view-change-hook', which is being deprecated
-and eventually will not be invoked.")
+This hook might be invoked multiple times by a single command.")
;;;_ = allout-structure-added-hook
(defvar allout-structure-added-hook nil
"*Hook that's run after addition of items to the outline.
Used by allout-auto-fill to do the mandated normal-auto-fill-function
wrapped within allout's automatic fill-prefix setting.")
(make-variable-buffer-local 'allout-outside-normal-auto-fill-function)
-;;;_ = file-var-bug hack
-(defvar allout-v18/19-file-var-hack nil
- "Horrible hack used to prevent invalid multiple triggering of outline
-mode from prop-line file-var activation. Used by `allout-mode' function
-to track repeats.")
+;;;_ = prevent redundant activation by desktop mode:
+(add-to-list 'desktop-minor-mode-handlers '(allout-mode . nil))
;;;_ = allout-passphrase-verifier-string
(defvar allout-passphrase-verifier-string nil
"Setting used to test solicited encryption passphrases against the one
the Emacs buffer state, if file variable adjustments are enabled. See
`allout-enable-file-variable-adjustment' for details about that.")
(make-variable-buffer-local 'allout-passphrase-verifier-string)
+(make-obsolete 'allout-passphrase-verifier-string
+ 'allout-passphrase-verifier-string "23.3")
;;;###autoload
(put 'allout-passphrase-verifier-string 'safe-local-variable 'stringp)
;;;_ = allout-passphrase-hint-string
`allout-enable-file-variable-adjustment' for details about that.")
(make-variable-buffer-local 'allout-passphrase-hint-string)
(setq-default allout-passphrase-hint-string "")
+(make-obsolete 'allout-passphrase-hint-string
+ 'allout-passphrase-hint-string "23.3")
;;;###autoload
(put 'allout-passphrase-hint-string 'safe-local-variable 'stringp)
;;;_ = allout-after-save-decrypt
(defvar allout-encryption-ciphertext-rejection-regexps nil
"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 --
-for example, a line that happens to look like an allout-mode topic prefix.
+This is used to detect strings in encryption results that would
+register as allout mode structural elements, for exmple, as a
+topic prefix.
Entries must be symbols that are bound to the desired regexp values.
-The encryption will be retried up to
-`allout-encryption-ciphertext-rejection-limit' times, after which an error
-is raised.")
+Encryptions that result in matches will be retried, up to
+`allout-encryption-ciphertext-rejection-limit' times, after which
+an error is raised.")
(make-variable-buffer-local 'allout-encryption-ciphertext-rejection-regexps)
;;;_ = allout-encryption-ciphertext-rejection-ceiling
(goto-char (cadr allout-after-save-decrypt))
(setq allout-after-save-decrypt nil))
)
+;;;_ > allout-called-interactively-p ()
+(defmacro allout-called-interactively-p ()
+ "A version of called-interactively-p independent of emacs version."
+ ;; ... to ease maintenance of allout without betraying deprecation.
+ (if (equal (subr-arity (symbol-function 'called-interactively-p))
+ '(0 . 0))
+ '(called-interactively-p)
+ '(called-interactively-p 'interactive)))
;;;_ = allout-inhibit-aberrance-doublecheck nil
;; In some exceptional moments, disparate topic depths need to be allowed
;; momentarily, eg when one topic is being yanked into another and they're
This should only be momentarily let-bound non-nil, not set
non-nil in a lasting way.")
-;;;_ #2 Mode activation
+;;;_ #2 Mode environment and activation
;;;_ = allout-explicitly-deactivated
(defvar allout-explicitly-deactivated nil
"If t, `allout-mode's last deactivation was deliberate.
\(allout-init t)"
(interactive)
- (if (interactive-p)
+ (if (allout-called-interactively-p)
(progn
(setq mode
(completing-read
(cond ((not mode)
(set find-file-hook-var-name
(delq hook (symbol-value find-file-hook-var-name)))
- (if (interactive-p)
+ (if (allout-called-interactively-p)
(message "Allout outline mode auto-activation inhibited.")))
((eq mode 'report)
(if (not (memq hook (symbol-value find-file-hook-var-name)))
(setplist 'allout-exposure-category nil)
(put 'allout-exposure-category 'invisible 'allout)
(put 'allout-exposure-category 'evaporate t)
- ;; XXX We use isearch-open-invisible *and* isearch-mode-end-hook. The
+ ;; ??? 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
'(allout-overlay-insert-in-front-handler)))
(put 'allout-exposure-category 'modification-hooks
'(allout-overlay-interior-modification-handler)))
-;;;_ > allout-mode (&optional toggle)
+;;;_ > define-minor-mode allout-mode
;;;_ : Defun:
;;;###autoload
-(defun allout-mode (&optional toggle)
+(define-minor-mode allout-mode
;;;_ . Doc string:
"Toggle minor mode for controlling exposure and editing of text outlines.
-\\<allout-mode-map>
+\\<allout-mode-map-value>
-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 always runs as a minor mode.
-Allout outline mode provides extensive outline oriented formatting and
-manipulation. It enables structural editing of outlines, as well as
-navigation and exposure. It also is specifically aimed at
-accommodating syntax-sensitive text like programming languages. (For
-an example, see the allout code itself, which is organized as an allout
-outline.)
+Allout outline mode provides extensive outline oriented
+formatting and manipulation. It enables structural editing of
+outlines, as well as navigation and exposure. It also is
+specifically aimed at accommodating syntax-sensitive text like
+programming languages. \(For example, see the allout code itself,
+which is organized as an allout outline.)
In addition to typical outline navigation and exposure, allout includes:
repositioning, promotion/demotion, cut, and paste
- incremental search with dynamic exposure and reconcealment of hidden text
- adjustable format, so programming code can be developed in outline-structure
- - easy topic encryption and decryption
+ - easy topic encryption and decryption, symmetric or key-pair
- \"Hot-spot\" operation, for single-keystroke maneuvering and exposure control
- integral outline layout, for automatic initial exposure when visiting a file
- independent extensibility, using comprehensive exposure and authoring hooks
and many other features.
-Below is a description of the key bindings, and then explanation of
-special `allout-mode' features and terminology. See also the outline
-menubar additions for quick reference to many of the features, and see
-the docstring of the function `allout-init' for instructions on
-priming your emacs session for automatic activation of `allout-mode'.
-
-The bindings are dictated by the customizable `allout-keybindings-list'
-variable. We recommend customizing `allout-command-prefix' to use just
-`\\C-c' as the command prefix, if the allout bindings don't conflict with
-any personal bindings you have on \\C-c. In any case, outline structure
-navigation and authoring is simplified by positioning the cursor on an
-item's bullet character, the \"hot-spot\" -- then you can invoke allout
-commands with just the un-prefixed, un-control-shifted command letters.
-This is described further in the HOT-SPOT Operation section.
+Below is a description of the key bindings, and then description
+of special `allout-mode' features and terminology. See also the
+outline menubar additions for quick reference to many of the
+features, and see the docstring of the function `allout-init' for
+instructions on priming your emacs session for automatic
+activation of `allout-mode'.
+
+The bindings are those listed in `allout-prefixed-keybindings'
+and `allout-unprefixed-keybindings'. We recommend customizing
+`allout-command-prefix' to use just `\\C-c' as the command
+prefix, if the allout bindings don't conflict with any personal
+bindings you have on \\C-c. In any case, outline structure
+navigation and authoring is simplified by positioning the cursor
+on an item's bullet character, the \"hot-spot\" -- then you can
+invoke allout commands with just the un-prefixed,
+un-control-shifted command letters. This is described further in
+the HOT-SPOT Operation section.
Exposure Control:
----------------
Topic Encryption
Outline mode supports gpg encryption of topics, with support for
-symmetric and key-pair modes, passphrase timeout, passphrase
-consistency checking, user-provided hinting for symmetric key
-mode, and auto-encryption of topics pending encryption on save.
+symmetric and key-pair modes, and auto-encryption of topics
+pending encryption on save.
Topics pending encryption are, by default, automatically
-encrypted during file saves. If the contents of the topic
-containing the cursor was encrypted for a save, it is
-automatically decrypted for continued editing.
-
-The aim of these measures is reliable topic privacy while
-preventing accidents like neglected encryption before saves,
-forgetting which passphrase was used, and other practical
-pitfalls.
+encrypted during file saves, including checkpoint saves, to avoid
+exposing the plain text of encrypted topics in the file system.
+If the content of the topic containing the cursor was encrypted
+for a save, it is automatically decrypted for continued editing.
+
+NOTE: A few GnuPG v2 versions improperly preserve incorrect
+symmetric decryption keys, preventing entry of the correct key on
+subsequent decryption attempts until the cache times-out. That
+can take several minutes. \(Decryption of other entries is not
+affected.) Upgrade your EasyPG version, if you can, and you can
+deliberately clear your gpg-agent's cache by sending it a '-HUP'
+signal.
See `allout-toggle-current-subtree-encryption' function docstring
and `allout-encrypt-unencrypted-on-saves' customization variable
this special translation, so you can use them to get out of the
hot-spot and back to normal editing operation.
-In allout-mode, the normal beginning-of-line command (\\[allout-beginning-of-line]]) is
+In allout-mode, the normal beginning-of-line command (\\[allout-beginning-of-line]) is
replaced with one that makes it easy to get to the hot-spot. If you
repeat it immediately it cycles (if `allout-beginning-of-line-cycles'
is set) to the beginning of the item and then, if you hit it again
without changes to the allout core. Here are key ones:
`allout-mode-hook'
-`allout-mode-deactivate-hook'
+`allout-mode-deactivate-hook' \(deprecated)
+`allout-mode-off-hook'
`allout-exposure-change-hook'
`allout-structure-added-hook'
`allout-structure-deleted-hook'
CLOSED: A TOPIC whose immediate OFFSPRING and body-text is CONCEALED.
OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be."
;;;_ . Code
- (interactive "P")
-
- (let* ((active (and (not (equal major-mode 'outline))
- (allout-mode-p)))
- ; Massage universal-arg `toggle' val:
- (toggle (and toggle
- (or (and (listp toggle)(car toggle))
- toggle)))
- ; Activation specifically demanded?
- (explicit-activation (and toggle
- (or (symbolp toggle)
- (and (wholenump toggle)
- (not (zerop toggle))))))
- ;; allout-mode already called once during this complex command?
- (same-complex-command (eq allout-v18/19-file-var-hack
- (car command-history)))
- (write-file-hook-var-name (cond ((boundp 'write-file-functions)
- 'write-file-functions)
- ((boundp 'write-file-hooks)
- 'write-file-hooks)
- (t 'local-write-file-hooks)))
- do-layout
- )
-
- ; See comments below re v19.18,.19 bug.
- (setq allout-v18/19-file-var-hack (car command-history))
-
- (cond
-
- ;; Provision for v19.18, 19.19 bug --
- ;; Emacs v 19.18, 19.19 file-var code invokes prop-line-designated
- ;; modes twice when file is visited. We have to avoid toggling mode
- ;; off on second invocation, so we detect it as best we can, and
- ;; skip everything.
- ((and same-complex-command ; Still in same complex command
- ; as last time `allout-mode' invoked.
- active ; Already activated.
- (not explicit-activation) ; Prop-line file-vars don't have args.
- (string-match "^19.1[89]" ; Bug only known to be in v19.18 and
- emacs-version)); 19.19.
- t)
-
- ;; Deactivation:
- ((and (not explicit-activation)
- (or active toggle))
- ; Activation not explicitly
- ; requested, and either in
- ; active state or *de*activation
- ; specifically requested:
- (setq allout-explicitly-deactivated t)
-
- (allout-do-resumptions)
-
- (remove-from-invisibility-spec '(allout . t))
- (remove-hook 'pre-command-hook 'allout-pre-command-business t)
- (remove-hook 'post-command-hook 'allout-post-command-business t)
- (remove-hook 'before-change-functions 'allout-before-change-handler t)
- (remove-hook 'isearch-mode-end-hook 'allout-isearch-end-handler t)
- (remove-hook write-file-hook-var-name 'allout-write-file-hook-handler t)
- (remove-hook 'auto-save-hook 'allout-auto-save-hook-handler t)
-
- (remove-overlays (point-min) (point-max)
- 'category 'allout-exposure-category)
-
- (setq allout-mode nil)
- (run-hooks 'allout-mode-deactivate-hook))
-
- ;; Activation:
- ((not active)
- (setq allout-explicitly-deactivated nil)
+ :lighter " Allout"
+ :keymap 'allout-mode-map
+
+ (let ((write-file-hook-var-name (cond ((boundp 'write-file-functions)
+ 'write-file-functions)
+ ((boundp 'write-file-hooks)
+ 'write-file-hooks)
+ (t 'local-write-file-hooks)))
+ (use-layout (if (listp allout-layout)
+ allout-layout
+ allout-default-layout)))
+
+ (if (not (allout-mode-p))
+ (progn
+ ;; Deactivation:
+
+ ; Activation not explicitly
+ ; requested, and either in
+ ; active state or *de*activation
+ ; specifically requested:
+ (allout-do-resumptions)
+
+ (remove-from-invisibility-spec '(allout . t))
+ (remove-hook 'pre-command-hook 'allout-pre-command-business t)
+ (remove-hook 'post-command-hook 'allout-post-command-business t)
+ (remove-hook 'before-change-functions 'allout-before-change-handler t)
+ (remove-hook 'isearch-mode-end-hook 'allout-isearch-end-handler t)
+ (remove-hook write-file-hook-var-name
+ 'allout-write-file-hook-handler t)
+ (remove-hook 'auto-save-hook 'allout-auto-save-hook-handler t)
+
+ (remove-overlays (point-min) (point-max)
+ 'category 'allout-exposure-category))
+
+ ;; Activating:
(if allout-old-style-prefixes
;; Inhibit all the fancy formatting:
(allout-add-resumptions '(allout-primary-bullet "*")))
(allout-infer-body-reindent)
(set-allout-regexp)
- (allout-add-resumptions
- '(allout-encryption-ciphertext-rejection-regexps
- allout-line-boundary-regexp
- extend)
- '(allout-encryption-ciphertext-rejection-regexps
- allout-bob-regexp
- extend))
-
- ;; Produce map from current version of allout-keybindings-list:
- (allout-setup-mode-map)
+ (allout-add-resumptions '(allout-encryption-ciphertext-rejection-regexps
+ allout-line-boundary-regexp
+ extend)
+ '(allout-encryption-ciphertext-rejection-regexps
+ allout-bob-regexp
+ extend))
+
+ (allout-compose-and-institute-keymap)
(produce-allout-mode-menubar-entries)
- ;; Include on minor-mode-map-alist, if not already there:
- (if (not (member '(allout-mode . allout-mode-map)
- minor-mode-map-alist))
- (setq minor-mode-map-alist
- (cons '(allout-mode . allout-mode-map)
- minor-mode-map-alist)))
-
(add-to-invisibility-spec '(allout . t))
(allout-add-resumptions '(line-move-ignore-invisible t))
(add-hook 'pre-command-hook 'allout-pre-command-business nil t)
(add-hook 'post-command-hook 'allout-post-command-business nil t)
- (add-hook 'before-change-functions 'allout-before-change-handler
- nil t)
+ (add-hook 'before-change-functions 'allout-before-change-handler nil t)
(add-hook 'isearch-mode-end-hook 'allout-isearch-end-handler nil t)
(add-hook write-file-hook-var-name 'allout-write-file-hook-handler
nil t)
- (add-hook 'auto-save-hook 'allout-auto-save-hook-handler
- nil t)
+ (add-hook 'auto-save-hook 'allout-auto-save-hook-handler nil t)
;; Stash auto-fill settings and adjust so custom allout auto-fill
;; func will be used if auto-fill is active or activated. (The
;; custom func respects topic headline, maintains hanging-indents,
;; etc.)
- (if (and auto-fill-function (not allout-inhibit-auto-fill))
- ;; allout-auto-fill will use the stashed values and so forth.
- (allout-add-resumptions '(auto-fill-function allout-auto-fill)))
(allout-add-resumptions (list 'allout-former-auto-filler
auto-fill-function)
;; Register allout-auto-fill to be used if
(list 'paragraph-separate
(concat paragraph-separate "\\|^\\("
allout-regexp "\\)")))
- (or (assq 'allout-mode minor-mode-alist)
- (setq minor-mode-alist
- (cons '(allout-mode " Allout") minor-mode-alist)))
+ (if (and auto-fill-function (not allout-inhibit-auto-fill))
+ ;; allout-auto-fill will use the stashed values and so forth.
+ (allout-add-resumptions '(auto-fill-function allout-auto-fill)))
(allout-setup-menubar)
- (if allout-layout
- (setq do-layout t))
-
- (setq allout-mode t)
- (run-hooks 'allout-mode-hook))
-
- ;; Reactivation:
- ((setq do-layout t)
- (allout-infer-body-reindent))
- ) ;; end of activation-mode cases.
-
- ;; Do auto layout if warranted:
- (let ((use-layout (if (listp allout-layout)
- allout-layout
- allout-default-layout)))
- (if (and do-layout
- allout-auto-activation
- use-layout
- (and (not (eq allout-auto-activation 'activate))
- (if (eq allout-auto-activation 'ask)
- (if (y-or-n-p (format "Expose %s with layout '%s'? "
- (buffer-name)
- use-layout))
- t
- (message "Skipped %s layout." (buffer-name))
- nil)
- t)))
- (save-excursion
- (message "Adjusting '%s' exposure..." (buffer-name))
- (goto-char 0)
- (allout-this-or-next-heading)
- (condition-case err
- (progn
- (apply 'allout-expose-topic (list use-layout))
- (message "Adjusting '%s' exposure... done." (buffer-name)))
- ;; Problem applying exposure -- notify user, but don't
- ;; interrupt, eg, file visit:
- (error (message "%s" (car (cdr err)))
- (sit-for 1))))))
- allout-mode
- ) ; let*
- ) ; defun
-
-(defun allout-setup-mode-map ()
- "Establish allout-mode bindings."
- (setq-default allout-mode-map
- (produce-allout-mode-map allout-keybindings-list))
- (setq allout-mode-map
- (produce-allout-mode-map allout-keybindings-list))
- (substitute-key-definition 'beginning-of-line
- 'allout-beginning-of-line
- allout-mode-map global-map)
- (substitute-key-definition 'move-beginning-of-line
- 'allout-beginning-of-line
- allout-mode-map global-map)
- (substitute-key-definition 'end-of-line
- 'allout-end-of-line
- allout-mode-map global-map)
- (substitute-key-definition 'move-end-of-line
- 'allout-end-of-line
- allout-mode-map global-map)
- (fset 'allout-mode-map allout-mode-map))
-
-;; ensure that allout-mode-map has some setting even if allout-mode hasn't
-;; been invoked:
-(allout-setup-mode-map)
-
-;;;_ > allout-minor-mode
+ ;; Do auto layout if warranted:
+ (when (and allout-layout
+ allout-auto-activation
+ use-layout
+ (and (not (eq allout-auto-activation 'activate))
+ (if (eq allout-auto-activation 'ask)
+ (if (y-or-n-p (format "Expose %s with layout '%s'? "
+ (buffer-name)
+ use-layout))
+ t
+ (message "Skipped %s layout." (buffer-name))
+ nil)
+ t)))
+ (save-excursion
+ (message "Adjusting '%s' exposure..." (buffer-name))
+ (goto-char 0)
+ (allout-this-or-next-heading)
+ (condition-case err
+ (progn
+ (apply 'allout-expose-topic (list use-layout))
+ (message "Adjusting '%s' exposure... done."
+ (buffer-name)))
+ ;; Problem applying exposure -- notify user, but don't
+ ;; interrupt, eg, file visit:
+ (error (message "%s" (car (cdr err)))
+ (sit-for 1))))
+ ) ; when allout-layout
+ ) ; if (allout-mode-p)
+ ) ; let (())
+ ) ; define-minor-mode
+;;;_ > allout-minor-mode alias
(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))))
+ (when (allout-mode-p) (allout-mode))))
;; continue standard unloading
nil)
;;;_ - Position Assessment
;;;_ > allout-hidden-p (&optional pos)
(defsubst allout-hidden-p (&optional pos)
- "Non-nil if the character after point is invisible."
+ "Non-nil if the character after point was made invisible by allout."
(eq (get-char-property (or pos (point)) 'invisible) 'allout))
;;;_ > allout-overlay-insert-in-front-handler (ol after beg end
&optional prelen)
"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?
+ ;; ??? Shouldn't moving the overlay should be unnecessary, if overlay
+ ;; front-advance on the overlay worked as expected?
(move-overlay ol (1+ beg) (overlay-end ol))))
;;;_ > allout-overlay-interior-modification-handler (ol after beg end
;;; &optional prelen)
(concat "Modify concealed text? (\"no\" just aborts,"
" \\[keyboard-quit] also reconceals) "))))
(progn (goto-char start)
- (error "Concealed-text change refused.")))
+ (error "Concealed-text change refused")))
(quit (allout-flag-region ol-start ol-end nil)
(allout-flag-region ol-start ol-end t)
- (error "Concealed-text change abandoned, text reconcealed."))))
+ (error "Concealed-text change abandoned, text reconcealed"))))
(goto-char start))))
;;;_ > allout-before-change-handler (beg end)
(defun allout-before-change-handler (beg end)
(save-excursion
(goto-char beg)
(let ((overlay (allout-get-invisibility-overlay)))
- (allout-overlay-interior-modification-handler
- overlay nil beg end nil)))))
+ (if overlay
+ (allout-overlay-interior-modification-handler
+ overlay nil beg end nil))))))
;;;_ > allout-isearch-end-handler (&optional overlay)
(defun allout-isearch-end-handler (&optional overlay)
"Reconcile allout outline exposure on arriving in hidden text after isearch.
(allout-show-to-offshoot)))
;;;_ #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'
-;;; when successful. Functions starting with `allout-recent-' all
-;;; use this state, providing the means to avoid redundant searches
-;;; for just-established data. This optimization can provide
-;;; significant speed improvement, but it must be employed carefully.
+;; 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'
+;; when successful. Functions starting with `allout-recent-' all
+;; use this state, providing the means to avoid redundant searches
+;; for just-established data. This optimization can provide
+;; significant speed improvement, but it must be employed carefully.
;;;_ = allout-recent-prefix-beginning
(defvar allout-recent-prefix-beginning 0
"Buffer point of the start of the last topic prefix encountered.")
;;;_ > 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' --
+ ;; 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))
(progn
(if (and (not (bolp))
(allout-hidden-p (1- (point))))
- (goto-char (previous-single-char-property-change
+ (goto-char (allout-previous-single-char-property-change
(1- (point)) 'invisible)))
(move-beginning-of-line 1))
(allout-depth)
(allout-back-to-current-heading)
(allout-end-of-current-line))
(t
- (if (not (and transient-mark-mode mark-active))
+ (if (not (allout-mark-active-p))
(push-mark))
(allout-end-of-entry))))))
+;;;_ > allout-mark-active-p ()
+(defun allout-mark-active-p ()
+ "True if the mark is currently or always active."
+ ;; `(cond (boundp...))' (or `(if ...)') invokes special byte-compiler
+ ;; provisions, at least in fsf emacs to prevent warnings about lack of,
+ ;; eg, region-active-p.
+ (cond ((boundp 'mark-active)
+ mark-active)
+ ((fboundp 'region-active-p)
+ (region-active-p))
+ (t)))
;;;_ > allout-next-heading ()
(defsubst allout-next-heading ()
"Move to the heading for the topic (possibly invisible) after this one.
(if (not (allout-current-depth))
nil
(1- allout-recent-prefix-end)))
-;;;_ > allout-back-to-current-heading ()
-(defun allout-back-to-current-heading ()
+;;;_ > allout-back-to-current-heading (&optional interactive)
+(defun allout-back-to-current-heading (&optional interactive)
"Move to heading line of current topic, or beginning if not in a topic.
If interactive, we position at the end of the prefix.
Return value of resulting point, unless we started outside
of (before any) topics, in which case we return nil."
+ (interactive "p")
+
(allout-beginning-of-current-line)
(let ((bol-point (point)))
- (if (allout-goto-prefix-doublechecked)
- (if (<= (point) bol-point)
- (if (interactive-p)
+ (when (allout-goto-prefix-doublechecked)
+ (if (<= (point) bol-point)
+ (progn
+ (setq bol-point (point))
+ (allout-beginning-of-current-line)
+ (if (not (= bol-point (point)))
+ (if (looking-at allout-regexp)
+ (allout-prefix-data)))
+ (if interactive
(allout-end-of-prefix)
- (point))
- (goto-char (point-min))
- nil))))
+ (point)))
+ (goto-char (point-min))
+ nil))))
;;;_ > allout-back-to-heading ()
(defalias 'allout-back-to-heading 'allout-back-to-current-heading)
;;;_ > allout-pre-next-prefix ()
Returns the value of point."
(interactive)
(allout-end-of-subtree t include-trailing-blank))
-;;;_ > allout-beginning-of-current-entry ()
-(defun allout-beginning-of-current-entry ()
+;;;_ > allout-beginning-of-current-entry (&optional interactive)
+(defun allout-beginning-of-current-entry (&optional interactive)
"When not already there, position point at beginning of current topic header.
If already there, move cursor to bullet for hot-spot operation.
\(See `allout-mode' doc string for details of hot-spot operation.)"
- (interactive)
+ (interactive "p")
(let ((start-point (point)))
(move-beginning-of-line 1)
(if (< 0 (allout-current-depth))
(goto-char allout-recent-prefix-end)
(goto-char (point-min)))
(allout-end-of-prefix)
- (if (and (interactive-p)
+ (if (and interactive
(= (point) start-point))
(goto-char (allout-current-bullet-pos)))))
;;;_ > allout-end-of-entry (&optional inclusive)
(while (and (< depth allout-recent-depth)
(setq last-ascended (allout-ascend))))
(goto-char allout-recent-prefix-beginning)
- (if (interactive-p) (allout-end-of-prefix))
+ (if (allout-called-interactively-p) (allout-end-of-prefix))
(and last-ascended allout-recent-depth))))
-;;;_ > allout-ascend ()
+;;;_ > allout-ascend (&optional dont-move-if-unsuccessful)
(defun allout-ascend (&optional dont-move-if-unsuccessful)
"Ascend one level, returning resulting depth if successful, nil if not.
(goto-char bolevel)
(allout-depth)
nil))))
- (if (interactive-p) (allout-end-of-prefix))))
+ (if (allout-called-interactively-p) (allout-end-of-prefix))))
;;;_ > allout-descend-to-depth (depth)
(defun allout-descend-to-depth (depth)
"Descend to depth DEPTH within current topic.
(if (not (allout-ascend))
(progn (goto-char start-point)
(error "Can't ascend past outermost level"))
- (if (interactive-p) (allout-end-of-prefix))
+ (if (allout-called-interactively-p) (allout-end-of-prefix))
allout-recent-prefix-beginning)))
;;;_ - Linear
(let ((depth (allout-depth)))
(while (allout-previous-sibling depth nil))
(prog1 allout-recent-depth
- (if (interactive-p) (allout-end-of-prefix)))))
+ (if (allout-called-interactively-p) (allout-end-of-prefix)))))
;;;_ > allout-next-visible-heading (arg)
(defun allout-next-visible-heading (arg)
"Move to the next ARG'th visible heading line, backward if arg is negative.
(let* ((inhibit-field-text-motion t)
(backward (if (< arg 0) (setq arg (* -1 arg))))
(step (if backward -1 1))
+ (progress (allout-current-bullet-pos))
prev got)
(while (> arg 0)
;; Move, skipping over all concealed lines in one fell swoop:
(prog1 (condition-case nil (or (line-move step) t)
(error nil))
- (allout-beginning-of-current-line))
+ (allout-beginning-of-current-line)
+ ;; line-move can wind up on the same line if long.
+ ;; when moving forward, that would yield no-progress
+ (when (and (not backward)
+ (<= (point) progress))
+ ;; ensure progress by doing line-move from end-of-line:
+ (end-of-line)
+ (condition-case nil (or (line-move step) t)
+ (error nil))
+ (allout-beginning-of-current-line)
+ (setq progress (point))))
;; Deal with apparent header line:
(save-match-data
(if (not (looking-at allout-regexp))
matches)."
(interactive "p")
(prog1 (allout-next-visible-heading (- arg))
- (if (interactive-p) (allout-end-of-prefix))))
+ (if (allout-called-interactively-p) (allout-end-of-prefix))))
;;;_ > allout-forward-current-level (arg)
(defun allout-forward-current-level (arg)
"Position point at the next heading of the same level.
(allout-previous-sibling)
(allout-next-sibling)))
(setq arg (1- arg)))
- (if (not (interactive-p))
+ (if (not (allout-called-interactively-p))
nil
(allout-end-of-prefix)
(if (not (zerop arg))
(defun allout-backward-current-level (arg)
"Inverse of `allout-forward-current-level'."
(interactive "p")
- (if (interactive-p)
+ (if (allout-called-interactively-p)
(let ((current-prefix-arg (* -1 arg)))
(call-interactively 'allout-forward-current-level))
(allout-forward-current-level (* -1 arg))))
then unset it. Set by `allout-pre-command-business' when implementing
hot-spot operation, where literal characters typed over a topic bullet
are mapped to the command of the corresponding control-key on the
-`allout-mode-map'.")
+`allout-mode-map-value'.")
(make-variable-buffer-local 'allout-post-goto-bullet)
;;;_ = allout-command-counter
(defvar allout-command-counter 0
Among other things, implements special behavior when the cursor is on the
topic bullet character.
-When the cursor is on the bullet character, self-insert characters are
-reinterpreted as the corresponding control-character in the
-`allout-mode-map'. The `allout-mode' `post-command-hook' insures that
-the cursor which has moved as a result of such reinterpretation is
-positioned on the bullet character of the destination topic.
+When the cursor is on the bullet character, self-insert
+characters are reinterpreted as the corresponding
+control-character in the `allout-mode-map-value'. The
+`allout-mode' `post-command-hook' insures that the cursor which
+has moved as a result of such reinterpretation is positioned on
+the bullet character of the destination topic.
The upshot is that you can get easy, single (ie, unmodified) key
outline maneuvering operations by positioning the cursor on the bullet
Returns the qualifying command, if any, else nil."
(interactive)
- (let* ((key-string (if (numberp last-command-char)
- (char-to-string last-command-char)))
- (key-num (cond ((numberp last-command-char) last-command-char)
+ (let* ((modified (event-modifiers last-command-event))
+ (key-num (cond ((numberp last-command-event) last-command-event)
;; for XEmacs character type:
((and (fboundp 'characterp)
- (apply 'characterp (list last-command-char)))
- (apply 'char-to-int (list last-command-char)))
+ (apply 'characterp (list last-command-event)))
+ (apply 'char-to-int (list last-command-event)))
(t 0)))
mapped-binding)
(if (and
;; exclude control chars and escape:
+ (not modified)
(<= 33 key-num)
(setq mapped-binding
- (or (and (assoc key-string allout-keybindings-list)
- ;; translate literal membership on list:
- (cadr (assoc key-string allout-keybindings-list)))
- ;; translate as a keybinding:
- (key-binding (vconcat allout-command-prefix
- (char-to-string
- (if (and (<= 97 key-num) ; "a"
- (>= 122 key-num)) ; "z"
- (- key-num 96) key-num)))
- t))))
+ ;; translate as a keybinding:
+ (key-binding (vconcat allout-command-prefix
+ (vector
+ (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.
(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))))
+ ;; accept-defaults nil, or else we get allout-item-icon-key-handler.
+ (setq mapped-binding (key-binding (vector key-num))))
(while (keymapp mapped-binding)
(setq mapped-binding
(lookup-key mapped-binding (vector (read-char)))))
- (if mapped-binding
- (setq this-command mapped-binding)))))
+ (when mapped-binding
+ (setq this-command mapped-binding)))))
;;;_ > allout-find-file-hook ()
(defun allout-find-file-hook ()
(if (and allout-auto-activation
(not (allout-mode-p))
allout-layout)
- (allout-mode t)))
+ (allout-mode)))
;;;_ - Topic Format Assessment
;;;_ > allout-solicit-alternate-bullet (depth &optional current-bullet)
(setq choice (solicit-char-in-string
(format "Select bullet: %s ('%s' default): "
sans-escapes
- (substring-no-properties default-bullet))
+ (allout-substring-no-properties default-bullet))
sans-escapes
t)))
(message "")
(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)))
+ (use-auto-fill-function
+ (if (and (eq allout-outside-normal-auto-fill-function
+ 'allout-auto-fill)
+ (eq auto-fill-function 'allout-auto-fill))
+ 'do-auto-fill
+ (or allout-outside-normal-auto-fill-function
+ auto-fill-function))))
(if (or allout-former-auto-filler allout-use-hanging-indents)
(funcall use-auto-fill-function)))))
;;;_ > allout-reindent-body (old-depth new-depth &optional number)
(if (not (allout-hidden-p))
(setq next
(max (1+ (point))
- (next-single-char-property-change (point)
- 'invisible
- nil end))))
+ (allout-next-single-char-property-change (point)
+ 'invisible
+ nil end))))
(if (or (not next) (eq prev next))
;; still not at start of hidden area -- must not be any left.
(setq done t)
(while (not done)
;; at or advance to start of next annotation:
(if (not (get-text-property (point) 'allout-was-hidden))
- (setq next (next-single-char-property-change (point)
- 'allout-was-hidden
- nil end)))
+ (setq next (allout-next-single-char-property-change
+ (point) 'allout-was-hidden nil end)))
(if (or (not next) (eq prev next))
;; no more or not advancing -- must not be any left.
(setq done t)
;; still not at start of annotation.
(setq done t)
;; advance to just after end of this annotation:
- (setq next (next-single-char-property-change (point)
- 'allout-was-hidden
- nil end))
+ (setq next (allout-next-single-char-property-change
+ (point) 'allout-was-hidden nil end))
(overlay-put (make-overlay prev next nil 'front-advance)
'category 'allout-exposure-category)
(allout-deannotate-hidden prev next)
(save-match-data
(save-excursion
(let* ((text-start allout-recent-prefix-end)
- (heading-end (progn (end-of-line) (point))))
+ (heading-end (point-at-eol)))
(goto-char text-start)
(setq file-name
(if (re-search-forward "\\s-\\(\\S-*\\)" heading-end t)
"Conceal text between FROM and TO if FLAG is non-nil, else reveal it.
Exposure-change hook `allout-exposure-change-hook' is run with the same
-arguments as this function, after the exposure changes are made. (The old
-`allout-view-change-hook' is being deprecated, and eventually will not be
-invoked.)"
+arguments as this function, after the exposure changes are made."
;; We use outline invisibility spec.
(remove-overlays from to 'category 'allout-exposure-category)
(when (featurep 'xemacs)
(let ((props (symbol-plist 'allout-exposure-category)))
(while props
- (overlay-put o (pop props) (pop props)))))))
- (run-hooks 'allout-view-change-hook)
+ (condition-case nil
+ ;; as of 2008-02-27, xemacs lacks modification-hooks
+ (overlay-put o (pop props) (pop props))
+ (error nil)))))))
(run-hook-with-args 'allout-exposure-change-hook from to flag))
;;;_ > allout-flag-current-subtree (flag)
(defun allout-flag-current-subtree (flag)
(to-reveal (or (allout-chart-to-reveal chart chart-level)
;; interactive, show discontinuous children:
(and chart
- (interactive-p)
+ (allout-called-interactively-p)
(save-excursion
(allout-back-to-current-heading)
(setq depth (allout-current-depth))
(and
;; Is the topic all on one line (allowing for trailing blank line)?
(>= (progn (allout-back-to-current-heading)
- (move-end-of-line 1)
+ (let ((inhibit-field-text-motion t))
+ (move-end-of-line 1))
(point))
(allout-end-of-current-subtree (not (looking-at "\n\n"))))
(goto-char beg)
(allout-topic-flat-index))
'(1))))
- (save-excursion (set-buffer tobuf)(erase-buffer))
+ (with-current-buffer tobuf (erase-buffer))
(allout-process-exposed 'allout-insert-listified
beg
end
(let ((inhibit-field-text-motion t))
(beginning-of-line)
(let ((beg (point))
- (end (progn (end-of-line)(point))))
- (goto-char beg)
+ (end (point-at-eol)))
(save-match-data
(while (re-search-forward "\\\\"
;;"\\\\\\|\\{\\|\\}\\|\\_\\|\\$\\|\\\"\\|\\&\\|\\^\\|\\-\\|\\*\\|#"
(goto-char start-pt)))
;;;_ #8 Encryption
-;;;_ > allout-toggle-current-subtree-encryption (&optional fetch-pass)
-(defun allout-toggle-current-subtree-encryption (&optional fetch-pass)
- "Encrypt clear or decrypt encoded text of visibly-containing topic's contents.
-
-Optional FETCH-PASS universal argument provokes key-pair encryption with
-single universal argument. With doubled universal argument (value = 16),
-it forces prompting for the passphrase regardless of availability from the
-passphrase cache. With no universal argument, the appropriate passphrase
-is obtained from the cache, if available, else from the user.
-
-Only GnuPG encryption is supported.
-
-\*NOTE WELL* that the encrypted text must be ascii-armored. For gnupg
-encryption, include the option ``armor'' in your ~/.gnupg/gpg.conf file.
-
-Both symmetric-key and key-pair encryption is implemented. Symmetric is
-the default, use a single (x4) universal argument for keypair mode.
-
-Encrypted topic's bullet is set to a `~' to signal that the contents of the
-topic (body and subtopics, but not heading) is pending encryption or
-encrypted. `*' asterisk immediately after the bullet signals that the body
-is encrypted, its' absence means the topic is meant to be encrypted but is
-not. When a file with topics pending encryption is saved, topics pending
-encryption are encrypted. See allout-encrypt-unencrypted-on-saves for
-auto-encryption specifics.
+;;;_ > allout-toggle-current-subtree-encryption (&optional keymode-cue)
+(defun allout-toggle-current-subtree-encryption (&optional keymode-cue)
+ "Encrypt clear or decrypt encoded topic text.
+
+Allout uses emacs 'epg' libary to perform encryption. Symmetric
+and keypair encryption are supported. All encryption is ascii
+armored.
+
+Entry encryption defaults to symmetric key mode unless keypair
+recipients are associated with the file \(see
+`epa-file-encrypt-to') or the function is invoked with a
+\(KEYMODE-CUE) universal argument greater than 1.
+
+When encrypting, KEYMODE-CUE universal argument greater than 1
+causes prompting for recipients for public-key keypair
+encryption. Selecting no recipients results in symmetric key
+encryption.
+
+Further, encrypting with a KEYMODE-CUE universal argument greater
+than 4 - eg, preceded by a doubled Ctrl-U - causes association of
+the specified recipients with the file, replacing those currently
+associated with it. This can be used to deassociate any
+recipients with the file, by selecting no recipients in the
+dialog.
+
+Encrypted topic's bullets are set to a `~' to signal that the
+contents of the topic (body and subtopics, but not heading) is
+pending encryption or encrypted. `*' asterisk immediately after
+the bullet signals that the body is encrypted, its absence means
+the topic is meant to be encrypted but is not currently. When a
+file with topics pending encryption is saved, topics pending
+encryption are encrypted. See allout-encrypt-unencrypted-on-saves
+for auto-encryption specifics.
\*NOTE WELL* that automatic encryption that happens during saves will
default to symmetric encryption -- you must deliberately (re)encrypt key-pair
Level-one topics, with prefix consisting solely of an `*' asterisk, cannot be
encrypted. If you want to encrypt the contents of a top-level topic, use
-\\[allout-shift-in] to increase its depth.
-
- Passphrase Caching
-
-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 cache, if enabled. See
-`pgg-cache-passphrase' and `pgg-passphrase-cache-expiry' for details.
-
- Symmetric Passphrase Hinting and Verification
-
-If the file previously had no associated passphrase, or had a different
-passphrase than specified, the user is prompted to repeat the new one for
-corroboration. A random string encrypted by the new passphrase is set on
-the buffer-specific variable `allout-passphrase-verifier-string', for
-confirmation of the passphrase when next obtained, before encrypting or
-decrypting anything with it. This helps avoid mistakenly shifting between
-keys.
-
-If allout customization var `allout-passphrase-verifier-handling' is
-non-nil, an entry for `allout-passphrase-verifier-string' and its value is
-added to an Emacs 'local variables' section at the end of the file, which
-is created if necessary. That setting is for retention of the passphrase
-verifier across Emacs sessions.
-
-Similarly, `allout-passphrase-hint-string' stores a user-provided reminder
-about their passphrase, and `allout-passphrase-hint-handling' specifies
-when the hint is presented, or if passphrase hints are disabled. If
-enabled (see the `allout-passphrase-hint-handling' docstring for details),
-the hint string is stored in the local-variables section of the file, and
-solicited whenever the passphrase is changed."
+\\[allout-shift-in] to increase its depth."
(interactive "P")
(save-excursion
(allout-back-to-current-heading)
- (allout-toggle-subtree-encryption fetch-pass)
- )
- )
-;;;_ > allout-toggle-subtree-encryption (&optional fetch-pass)
-(defun allout-toggle-subtree-encryption (&optional fetch-pass)
+ (allout-toggle-subtree-encryption keymode-cue)))
+;;;_ > allout-toggle-subtree-encryption (&optional keymode-cue)
+(defun allout-toggle-subtree-encryption (&optional keymode-cue)
"Encrypt clear text or decrypt encoded topic contents (body and subtopics.)
-Optional FETCH-PASS universal argument provokes key-pair encryption with
-single universal argument. With doubled universal argument (value = 16),
-it forces prompting for the passphrase regardless of availability from the
-passphrase cache. With no universal argument, the appropriate passphrase
-is obtained from the cache, if available, else from the user.
+Entry encryption defaults to symmetric key mode unless keypair
+recipients are associated with the file \(see
+`epa-file-encrypt-to') or the function is invoked with a
+\(KEYMODE-CUE) universal argument greater than 1.
+
+When encrypting, KEYMODE-CUE universal argument greater than 1
+causes prompting for recipients for public-key keypair
+encryption. Selecting no recipients results in symmetric key
+encryption.
+
+Further, encrypting with a KEYMODE-CUE universal argument greater
+than 4 - eg, preceded by a doubled Ctrl-U - causes association of
+the specified recipients with the file, replacing those currently
+associated with it. This can be used to deassociate any
+recipients with the file, by selecting no recipients in the
+dialog.
-Currently only GnuPG encryption is supported, and integration
-with gpg-agent is not yet implemented.
+Encryption and decryption uses the emacs epg library.
-\**NOTE WELL** that the encrypted text must be ascii-armored. For gnupg
-encryption, include the option ``armor'' in your ~/.gnupg/gpg.conf file.
+Encrypted text will be ascii-armored.
See `allout-toggle-current-subtree-encryption' for more details."
(if was-encrypted "de" "en"))
nil))
;; Assess key parameters:
- (key-info (or
- ;; detect the type by which it is already encrypted
- (and was-encrypted
- (allout-encrypted-key-info subject-text))
- (and (member fetch-pass '(4 (4)))
- '(keypair nil))
- '(symmetric nil)))
- (for-key-type (car key-info))
- (for-key-identity (cadr key-info))
- (fetch-pass (and fetch-pass (member fetch-pass '(16 (16)))))
(was-coding-system buffer-file-coding-system))
(when (not was-encrypted)
;; they're encrypted, so the coding system is set to accommodate
;; them.
(setq buffer-file-coding-system
- (select-safe-coding-system subtree-beg subtree-end))
+ (allout-select-safe-coding-system subtree-beg subtree-end))
;; if the coding system for the text being encrypted is different
;; than that prevailing, then there a real risk that the coding
;; system can't be noticed by emacs when the file is visited. to
(setq result-text
(allout-encrypt-string subject-text was-encrypted
- (current-buffer)
- for-key-type for-key-identity fetch-pass))
+ (current-buffer) keymode-cue))
;; Replace the subtree with the processed product.
(allout-unprotected
(insert "*"))))
(run-hook-with-args 'allout-structure-added-hook
bullet-pos subtree-end))))
-;;;_ > allout-encrypt-string (text decrypt allout-buffer key-type for-key
-;;; fetch-pass &optional retried verifying
-;;; passphrase)
-(defun allout-encrypt-string (text decrypt allout-buffer key-type for-key
- fetch-pass &optional retried rejected
- verifying passphrase)
+;;;_ > allout-encrypt-string (text decrypt allout-buffer keymode-cue
+;;; &optional rejected)
+(defun allout-encrypt-string (text decrypt allout-buffer keymode-cue
+ &optional rejected)
"Encrypt or decrypt message TEXT.
-If DECRYPT is true (default false), then decrypt instead of encrypt.
+Returns the resulting string, or nil if the transformation fails.
-FETCH-PASS (default false) forces fresh prompting for the passphrase.
+If DECRYPT is true (default false), then decrypt instead of encrypt.
-KEY-TYPE, either `symmetric' or `keypair', specifies which type
-of cypher to use.
+ALLOUT-BUFFER identifies the buffer containing the text.
-FOR-KEY is human readable identification of the first of the user's
-eligible secret keys a keypair decryption targets, or else nil.
+Entry encryption defaults to symmetric key mode unless keypair
+recipients are associated with the file \(see
+`epa-file-encrypt-to') or the function is invoked with a
+\(KEYMODE-CUE) universal argument greater than 1.
-Optional RETRIED is for internal use -- conveys the number of failed keys
-that have been solicited in sequence leading to this current call.
+When encrypting, KEYMODE-CUE universal argument greater than 1
+causes prompting for recipients for public-key keypair
+encryption. Selecting no recipients results in symmetric key
+encryption.
-Optional PASSPHRASE enables explicit delivery of the decryption passphrase,
-for verification purposes.
+Further, encrypting with a KEYMODE-CUE universal argument greater
+than 4 - eg, preceded by a doubled Ctrl-U - causes association of
+the specified recipients with the file, replacing those currently
+associated with it. This can be used to deassociate any
+recipients with the file, by selecting no recipients in the
+dialog.
-Optional REJECTED is for internal use -- conveys the number of
+Optional REJECTED is for internal use, to convey the number of
rejections due to matches against
`allout-encryption-ciphertext-rejection-regexps', as limited by
`allout-encryption-ciphertext-rejection-ceiling'.
-Returns the resulting string, or nil if the transformation fails."
-
- (require 'pgg)
-
- (if (not (fboundp 'pgg-encrypt-symmetric))
- (error "Allout encryption depends on a newer version of pgg"))
-
- (let* ((scheme (upcase
- (format "%s" (or pgg-scheme pgg-default-scheme "GPG"))))
- (for-key (and (equal key-type 'keypair)
- (or for-key
- (split-string (read-string
- (format "%s message recipients: "
- scheme))
- "[ \t,]+"))))
- (target-prompt-id (if (equal key-type 'keypair)
- (if (= (length for-key) 1)
- (car for-key) for-key)
- (buffer-name allout-buffer)))
- (target-cache-id (format "%s-%s"
- key-type
- (if (equal key-type 'keypair)
- target-prompt-id
- (or (buffer-file-name allout-buffer)
- target-prompt-id))))
+NOTE: A few GnuPG v2 versions improperly preserve incorrect
+symmetric decryption keys, preventing entry of the correct key on
+subsequent decryption attempts until the cache times-out. That
+can take several minutes. \(Decryption of other entries is not
+affected.) Upgrade your EasyPG version, if you can, and you can
+deliberately clear your gpg-agent's cache by sending it a '-HUP'
+signal."
+
+ (require 'epg)
+ (require 'epa)
+
+ (let* ((epg-context (let* ((context (epg-make-context nil t)))
+ (epg-context-set-passphrase-callback
+ context #'epa-passphrase-callback-function)
+ context))
(encoding (with-current-buffer allout-buffer
buffer-file-coding-system))
(multibyte (with-current-buffer allout-buffer
- enable-multibyte-characters))
- (strip-plaintext-regexps
- (if (not decrypt)
- (allout-get-configvar-values
- 'allout-encryption-plaintext-sanitization-regexps)))
- (reject-ciphertext-regexps
- (if (not decrypt)
- (allout-get-configvar-values
- 'allout-encryption-ciphertext-rejection-regexps)))
+ enable-multibyte-characters))
+ ;; "sanitization" avoids encryption results that are outline structure.
+ (sani-regexps 'allout-encryption-plaintext-sanitization-regexps)
+ (strip-plaintext-regexps (if (not decrypt)
+ (allout-get-configvar-values
+ sani-regexps)))
+ (rejection-regexps 'allout-encryption-ciphertext-rejection-regexps)
+ (reject-ciphertext-regexps (if (not decrypt)
+ (allout-get-configvar-values
+ rejection-regexps)))
(rejected (or rejected 0))
(rejections-left (- allout-encryption-ciphertext-rejection-ceiling
rejected))
- result-text status
+ (keypair-mode (cond (decrypt 'decrypting)
+ ((<= (prefix-numeric-value keymode-cue) 1)
+ 'default)
+ ((<= (prefix-numeric-value keymode-cue) 4)
+ 'prompt)
+ ((> (prefix-numeric-value keymode-cue) 4)
+ 'prompt-save)))
+ (keypair-message (concat "Select encryption recipients.\n"
+ "Symmetric encryption is done if no"
+ " recipients are selected. "))
+ (encrypt-to (and (boundp 'epa-file-encrypt-to) epa-file-encrypt-to))
+ recipients
+ massaged-text
+ result-text
)
- (if (and fetch-pass (not passphrase))
- ;; Force later fetch by evicting passphrase from the cache.
- (pgg-remove-passphrase-from-cache target-cache-id t))
-
- (catch 'encryption-failed
-
- ;; 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
- key-type
- allout-buffer
- retried fetch-pass)))
-
- (with-temp-buffer
-
- (insert text)
-
- ;; convey the text characteristics of the original buffer:
- (set-buffer-multibyte multibyte)
- (when encoding
- (set-buffer-file-coding-system encoding)
- (if (not decrypt)
- (encode-coding-region (point-min) (point-max) encoding)))
-
- (when (and strip-plaintext-regexps (not decrypt))
- (dolist (re strip-plaintext-regexps)
- (let ((re (if (listp re) (car re) re))
- (replacement (if (listp re) (cadr re) "")))
- (goto-char (point-min))
- (save-match-data
- (while (re-search-forward re nil t)
- (replace-match replacement nil nil))))))
-
- (cond
-
- ;; symmetric:
- ((equal key-type 'symmetric)
- (setq status
- (if decrypt
-
- (pgg-decrypt (point-min) (point-max) passphrase)
-
- (pgg-encrypt-symmetric (point-min) (point-max)
- passphrase)))
-
- (if status
- (pgg-situate-output (point-min) (point-max))
- ;; 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"
- (if decrypt "de" "en")
- "try again with different passphrase"))))
-
- ;; encrypt `keypair':
- ((not decrypt)
-
- (setq status
-
- (pgg-encrypt for-key
- nil (point-min) (point-max) passphrase))
-
- (if status
- (pgg-situate-output (point-min) (point-max))
- (error (pgg-remove-passphrase-from-cache target-cache-id t)
- (error "encryption failed"))))
-
- ;; decrypt `keypair':
- (t
-
- (setq status
- (pgg-decrypt (point-min) (point-max) passphrase))
-
- (if status
- (pgg-situate-output (point-min) (point-max))
- (error (pgg-remove-passphrase-from-cache target-cache-id t)
- (error "decryption failed")))))
-
- (setq result-text
- (buffer-substring-no-properties
- 1 (- (point-max) (if decrypt 0 1))))
- )
-
- ;; validate result -- non-empty
- (cond ((not result-text)
- (if verifying
- nil
- ;; transform was fruitless, retry w/new passphrase.
- (pgg-remove-passphrase-from-cache target-cache-id t)
- (allout-encrypt-string text decrypt allout-buffer
- key-type for-key nil
- (if retried (1+ retried) 1)
- rejected verifying nil)))
-
- ;; Retry (within limit) if ciphertext contains rejections:
- ((and (not decrypt)
- ;; Check for disqualification of this ciphertext:
- (let ((regexps reject-ciphertext-regexps)
- reject-it)
- (while (and regexps (not reject-it))
- (setq reject-it (string-match (car regexps)
- result-text))
- (pop regexps))
- reject-it))
- (setq rejections-left (1- rejections-left))
- (if (<= rejections-left 0)
- (error (concat "Ciphertext rejected too many times"
- " (%s), per `%s'")
- allout-encryption-ciphertext-rejection-ceiling
- 'allout-encryption-ciphertext-rejection-regexps)
- (allout-encrypt-string text decrypt allout-buffer
- key-type for-key nil
- retried (1+ rejected)
- verifying passphrase)))
- ;; Barf if encryption yields extraordinary control chars:
- ((and (not decrypt)
- (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!")))
-
- ;; valid result and just verifying or non-symmetric:
- ((or verifying (not (equal key-type 'symmetric)))
- (if (or verifying decrypt)
- (pgg-add-passphrase-to-cache target-cache-id
- passphrase t))
- result-text)
-
- ;; valid result and regular symmetric -- "register"
- ;; passphrase with mnemonic aids/cache.
- (t
- (set-buffer allout-buffer)
- (if passphrase
- (pgg-add-passphrase-to-cache target-cache-id
- passphrase t))
- (allout-update-passphrase-mnemonic-aids for-key passphrase
- allout-buffer)
- result-text)
- )
- )
- )
- )
-;;;_ > allout-obtain-passphrase (for-key cache-id prompt-id key-type
-;;; allout-buffer retried fetch-pass)
-(defun allout-obtain-passphrase (for-key cache-id prompt-id key-type
- allout-buffer retried fetch-pass)
- "Obtain passphrase for a key from the cache or else from the user.
-
-When obtaining from the user, symmetric-cipher passphrases are verified
-against either, if available and enabled, a random string that was
-encrypted against the passphrase, or else against repeated entry by the
-user for corroboration.
-
-FOR-KEY is the key for which the passphrase is being obtained.
-
-CACHE-ID is the cache id of the key for the passphrase.
-
-PROMPT-ID is the id for use when prompting the user.
-
-KEY-TYPE is either `symmetric' or `keypair'.
-
-ALLOUT-BUFFER is the buffer containing the entry being en/decrypted.
-
-RETRIED is the number of this attempt to obtain this passphrase.
-
-FETCH-PASS causes the passphrase to be solicited from the user, regardless
-of the availability of a cached copy."
-
- (if (not (equal key-type 'symmetric))
- ;; do regular passphrase read on non-symmetric passphrase:
- (pgg-read-passphrase (format "%s passphrase%s: "
- (upcase (format "%s" (or pgg-scheme
- pgg-default-scheme
- "GPG")))
- (if prompt-id
- (format " for %s" prompt-id)
- ""))
- cache-id t)
-
- ;; Symmetric hereon:
-
- (save-excursion
- (set-buffer allout-buffer)
- (let* ((hint (if (and (not (string= allout-passphrase-hint-string ""))
- (or (equal allout-passphrase-hint-handling 'always)
- (and (equal allout-passphrase-hint-handling
- 'needed)
- retried)))
- (format " [%s]" allout-passphrase-hint-string)
- ""))
- (retry-message (if retried (format " (%s retry)" retried) ""))
- (prompt-sans-hint (format "'%s' symmetric passphrase%s: "
- prompt-id retry-message))
- (full-prompt (format "'%s' symmetric passphrase%s%s: "
- prompt-id hint retry-message))
- (prompt full-prompt)
- (verifier-string (allout-get-encryption-passphrase-verifier))
-
- (cached (and (not fetch-pass)
- (pgg-read-passphrase-from-cache cache-id t)))
- (got-pass (or cached
- (pgg-read-passphrase full-prompt cache-id t)))
- confirmation)
-
- (if (not got-pass)
- nil
+ ;; Massage the subject text for encoding and filtering.
+ (with-temp-buffer
+ (insert text)
+ ;; convey the text characteristics of the original buffer:
+ (allout-set-buffer-multibyte multibyte)
+ (when encoding
+ (set-buffer-file-coding-system encoding)
+ (if (not decrypt)
+ (encode-coding-region (point-min) (point-max) encoding)))
+
+ ;; remove sanitization regexps matches before encrypting:
+ (when (and strip-plaintext-regexps (not decrypt))
+ (dolist (re strip-plaintext-regexps)
+ (let ((re (if (listp re) (car re) re))
+ (replacement (if (listp re) (cadr re) "")))
+ (goto-char (point-min))
+ (save-match-data
+ (while (re-search-forward re nil t)
+ (replace-match replacement nil nil))))))
+ (setq massaged-text (buffer-substring-no-properties (point-min)
+ (point-max))))
+ ;; determine key mode and, if keypair, recipients:
+ (setq recipients
+ (case keypair-mode
+
+ (decrypting nil)
+
+ (default (if encrypt-to (epg-list-keys epg-context encrypt-to)))
+
+ ((prompt prompt-save)
+ (save-window-excursion
+ (epa-select-keys epg-context keypair-message)))))
+
+ (setq result-text
+ (if decrypt
+ (epg-decrypt-string epg-context
+ (encode-coding-string massaged-text
+ (or encoding 'utf-8)))
+ (replace-regexp-in-string "\n$" ""
+ (epg-encrypt-string epg-context
+ (encode-coding-string massaged-text
+ (or encoding 'utf-8))
+ recipients))))
+
+ ;; validate result -- non-empty
+ (if (not result-text)
+ (error "%scryption failed." (if decrypt "De" "En")))
+
+
+ (when (eq keypair-mode 'prompt-save)
+ ;; set epa-file-encrypt-to in the buffer:
+ (setq epa-file-encrypt-to (mapcar (lambda (key)
+ (epg-user-id-string
+ (car (epg-key-user-id-list key))))
+ recipients))
+ ;; change the file variable:
+ (allout-adjust-file-variable "epa-file-encrypt-to" epa-file-encrypt-to))
- ;; Duplicate our handle on the passphrase so it's not clobbered by
- ;; deactivate-passwd memory clearing:
- (setq got-pass (copy-sequence got-pass))
-
- (cond (verifier-string
- (save-window-excursion
- (if (allout-encrypt-string verifier-string 'decrypt
- allout-buffer 'symmetric
- for-key nil 0 0 'verifying
- (copy-sequence got-pass))
- (setq confirmation (format "%s" got-pass))))
-
- (if (and (not confirmation)
- (if (yes-or-no-p
- (concat "Passphrase differs from established"
- " -- use new one instead? "))
- ;; deactivate password for subsequent
- ;; confirmation:
- (progn
- (pgg-remove-passphrase-from-cache cache-id t)
- (setq prompt prompt-sans-hint)
- nil)
- t))
- (progn (pgg-remove-passphrase-from-cache cache-id t)
- (error "Wrong passphrase."))))
- ;; 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
- ;; right thing, in either case:
- (if (not confirmation)
- (setq confirmation
- (pgg-read-passphrase (concat prompt
- " ... confirm spelling: ")
- cache-id t)))
- (prog1
- (if (equal got-pass confirmation)
- confirmation
- (if (yes-or-no-p (concat "spelling of original and"
- " confirmation differ -- retry? "))
- (progn (setq retried (if retried (1+ retried) 1))
- (pgg-remove-passphrase-from-cache cache-id t)
- ;; recurse to this routine:
- (pgg-read-passphrase prompt-sans-hint cache-id t))
- (pgg-remove-passphrase-from-cache cache-id t)
- (error "Confirmation failed."))))))))
+ (cond
+ ;; Retry (within limit) if ciphertext contains rejections:
+ ((and (not decrypt)
+ ;; Check for disqualification of this ciphertext:
+ (let ((regexps reject-ciphertext-regexps)
+ reject-it)
+ (while (and regexps (not reject-it))
+ (setq reject-it (string-match (car regexps) result-text))
+ (pop regexps))
+ reject-it))
+ (setq rejections-left (1- rejections-left))
+ (if (<= rejections-left 0)
+ (error (concat "Ciphertext rejected too many times"
+ " (%s), per `%s'")
+ allout-encryption-ciphertext-rejection-ceiling
+ 'allout-encryption-ciphertext-rejection-regexps)
+ ;; try again (gpg-agent may have the key cached):
+ (allout-encrypt-string text decrypt allout-buffer keypair-mode
+ (1+ rejected))))
+
+ ;; Barf if encryption yields extraordinary control chars:
+ ((and (not decrypt)
+ (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!")))
+
+ (t result-text))))
;;;_ > allout-encrypted-topic-p ()
(defun allout-encrypted-topic-p ()
"True if the current topic is encryptable and encrypted."
(save-match-data (looking-at "\\*")))
)
)
-;;;_ > allout-encrypted-key-info (text)
-;; XXX gpg-specific, alas
-(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'.
-
-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."
- (require 'pgg-parse)
- (save-excursion
- (with-temp-buffer
- (insert text)
- (let* ((parsed-armor (pgg-parse-armor-region (point-min) (point-max)))
- (type (if (pgg-gpg-symmetric-key-p parsed-armor)
- 'symmetric
- 'keypair))
- secret-keys first-secret-key for-key-owner)
- (if (equal type 'keypair)
- (setq secret-keys (pgg-gpg-lookup-all-secret-keys)
- first-secret-key (pgg-gpg-select-matching-key parsed-armor
- secret-keys)
- for-key-owner (and first-secret-key
- (pgg-gpg-lookup-key-owner
- first-secret-key))))
- (list type (pgg-gpg-key-id-from-key-owner for-key-owner))
- )
- )
- )
- )
-;;;_ > allout-create-encryption-passphrase-verifier (passphrase)
-(defun allout-create-encryption-passphrase-verifier (passphrase)
- "Encrypt random message for later validation of symmetric key's passphrase."
- ;; use 20 random ascii characters, across the entire ascii range.
- (random t)
- (let ((spew (make-string 20 ?\0)))
- (dotimes (i (length spew))
- (aset spew i (1+ (random 254))))
- (allout-encrypt-string spew nil (current-buffer) 'symmetric
- nil nil 0 0 passphrase))
- )
-;;;_ > allout-update-passphrase-mnemonic-aids (for-key passphrase
-;;; outline-buffer)
-(defun allout-update-passphrase-mnemonic-aids (for-key passphrase
- outline-buffer)
- "Update passphrase verifier and hint strings if necessary.
-
-See `allout-passphrase-verifier-string' and `allout-passphrase-hint-string'
-settings.
-
-PASSPHRASE is the passphrase being mnemonicized.
-
-OUTLINE-BUFFER is the buffer of the outline being adjusted.
-
-These are used to help the user keep track of the passphrase they use for
-symmetric encryption in the file.
-
-Behavior is governed by `allout-passphrase-verifier-handling',
-`allout-passphrase-hint-handling', and also, controlling whether the values
-are preserved on Emacs local file variables,
-`allout-enable-file-variable-adjustment'."
-
- ;; If passphrase doesn't agree with current verifier:
- ;; - adjust the verifier
- ;; - if passphrase hint handling is enabled, adjust the passphrase hint
- ;; - if file var settings are enabled, adjust the file vars
-
- (let* ((new-verifier-needed (not (allout-verify-passphrase
- for-key passphrase outline-buffer)))
- (new-verifier-string
- (if new-verifier-needed
- ;; Collapse to a single line and enclose in string quotes:
- (subst-char-in-string
- ?\n ?\C-a (allout-create-encryption-passphrase-verifier
- passphrase))))
- new-hint)
- (when new-verifier-string
- ;; do the passphrase hint first, since it's interactive
- (when (and allout-passphrase-hint-handling
- (not (equal allout-passphrase-hint-handling 'disabled)))
- (setq new-hint
- (read-from-minibuffer "Passphrase hint to jog your memory: "
- allout-passphrase-hint-string))
- (when (not (string= new-hint allout-passphrase-hint-string))
- (setq allout-passphrase-hint-string new-hint)
- (allout-adjust-file-variable "allout-passphrase-hint-string"
- allout-passphrase-hint-string)))
- (when allout-passphrase-verifier-handling
- (setq allout-passphrase-verifier-string new-verifier-string)
- (allout-adjust-file-variable "allout-passphrase-verifier-string"
- allout-passphrase-verifier-string))
- )
- )
- )
-;;;_ > allout-get-encryption-passphrase-verifier ()
-(defun allout-get-encryption-passphrase-verifier ()
- "Return text of the encrypt passphrase verifier, unmassaged, or nil if none.
-
-Derived from value of `allout-passphrase-verifier-string'."
-
- (let ((verifier-string (and (boundp 'allout-passphrase-verifier-string)
- allout-passphrase-verifier-string)))
- (if verifier-string
- ;; Return it uncollapsed
- (subst-char-in-string ?\C-a ?\n verifier-string))
- )
- )
-;;;_ > allout-verify-passphrase (key passphrase allout-buffer)
-(defun allout-verify-passphrase (key passphrase allout-buffer)
- "True if passphrase successfully decrypts verifier, nil otherwise.
-
-\"Otherwise\" includes absence of passphrase verifier."
- (save-excursion
- (set-buffer allout-buffer)
- (and (boundp 'allout-passphrase-verifier-string)
- allout-passphrase-verifier-string
- (allout-encrypt-string (allout-get-encryption-passphrase-verifier)
- 'decrypt allout-buffer 'symmetric
- key nil 0 0 'verifying passphrase)
- t)))
;;;_ > allout-next-topic-pending-encryption (&optional except-mark)
(defun allout-next-topic-pending-encryption (&optional except-mark)
"Return the point of the next topic pending encryption, or nil if none.
(interactive "P")
- (allout-mode t)
+ (if (allout-mode-p) (allout-mode)) ; deactivate so we can re-activate...
+ (allout-mode)
(save-excursion
(goto-char (point-min))
((atom (car list)) (cons (car list) (allout-flatten (cdr list))))
(t (append (allout-flatten (car list)) (allout-flatten (cdr list))))))
;;;_ : Compatibility:
+;;;_ : xemacs undo-in-progress provision:
+(unless (boundp 'undo-in-progress)
+ (defvar undo-in-progress nil
+ "Placeholder defvar for XEmacs compatibility from allout.el.")
+ (defadvice undo-more (around allout activate)
+ ;; This defadvice used only in emacs that lack undo-in-progress, eg xemacs.
+ (let ((undo-in-progress t)) ad-do-it)))
+
;;;_ > allout-mark-marker to accommodate divergent emacsen:
(defun allout-mark-marker (&optional force buffer)
"Accommodate the different signature for `mark-marker' across Emacsen.
(skip-chars-backward "^\n"))
(vertical-motion 0))
)
-;;;_ > move-end-of-line if necessary -- older emacs, xemacs
+;;;_ > move-end-of-line if necessary -- Emacs < 22.1, xemacs
(if (not (fboundp 'move-end-of-line))
(defun move-end-of-line (arg)
"Move point to end of current line as displayed.
(setq arg 1)
(setq done t)))))))
)
+;;;_ > allout-next-single-char-property-change -- alias unless lacking
+(defalias 'allout-next-single-char-property-change
+ (if (fboundp 'next-single-char-property-change)
+ 'next-single-char-property-change
+ 'next-single-property-change)
+ ;; No docstring because xemacs defalias doesn't support it.
+ )
+;;;_ > allout-previous-single-char-property-change -- alias unless lacking
+(defalias 'allout-previous-single-char-property-change
+ (if (fboundp 'previous-single-char-property-change)
+ 'previous-single-char-property-change
+ 'previous-single-property-change)
+ ;; No docstring because xemacs defalias doesn't support it.
+ )
+;;;_ > allout-set-buffer-multibyte
+(if (fboundp 'set-buffer-multibyte)
+ (defalias 'allout-set-buffer-multibyte 'set-buffer-multibyte)
+ (with-no-warnings
+ ;; this definition is used only in older or alternative emacs, where
+ ;; the setting is our only recourse.
+ (defun allout-set-buffer-multibyte (is-multibyte)
+ (set enable-multibyte-characters is-multibyte))))
+;;;_ > allout-select-safe-coding-system
+(defalias 'allout-select-safe-coding-system
+ (if (fboundp 'select-safe-coding-system)
+ 'select-safe-coding-system
+ 'detect-coding-region)
+ )
+;;;_ > allout-substring-no-properties
+;; define as alias first, so byte compiler is happy.
+(defalias 'allout-substring-no-properties 'substring-no-properties)
+;; then supplant with definition if underlying alias absent.
+(if (not (fboundp 'substring-no-properties))
+ (defun allout-substring-no-properties (string &optional start end)
+ (substring string (or start 0) end))
+ )
;;;_ #10 Unfinished
;;;_ > allout-bullet-isearch (&optional bullet)
;;;_ > allout-tests-obliterate-variable (name)
(defun allout-tests-obliterate-variable (name)
"Completely unbind variable with NAME."
- (if (local-variable-p name) (kill-local-variable name))
+ (if (local-variable-p name (current-buffer)) (kill-local-variable name))
(while (boundp name) (makunbound name)))
;;;_ > allout-test-resumptions ()
(defvar allout-tests-globally-unbound nil
(allout-tests-obliterate-variable 'allout-tests-globally-unbound)
(allout-add-resumptions '(allout-tests-globally-unbound t))
(assert (not (default-boundp 'allout-tests-globally-unbound)))
- (assert (local-variable-p 'allout-tests-globally-unbound))
+ (assert (local-variable-p 'allout-tests-globally-unbound (current-buffer)))
(assert (boundp 'allout-tests-globally-unbound))
(assert (equal allout-tests-globally-unbound t))
(allout-do-resumptions)
- (assert (not (local-variable-p 'allout-tests-globally-unbound)))
+ (assert (not (local-variable-p 'allout-tests-globally-unbound
+ (current-buffer))))
(assert (not (boundp 'allout-tests-globally-unbound))))
;; ensure that variable with prior global value is resumed
(setq allout-tests-globally-true t)
(allout-add-resumptions '(allout-tests-globally-true nil))
(assert (equal (default-value 'allout-tests-globally-true) t))
- (assert (local-variable-p 'allout-tests-globally-true))
+ (assert (local-variable-p 'allout-tests-globally-true (current-buffer)))
(assert (equal allout-tests-globally-true nil))
(allout-do-resumptions)
- (assert (not (local-variable-p 'allout-tests-globally-true)))
+ (assert (not (local-variable-p 'allout-tests-globally-true
+ (current-buffer))))
(assert (boundp 'allout-tests-globally-true))
(assert (equal allout-tests-globally-true t)))
(assert (not (default-boundp 'allout-tests-locally-true))
nil (concat "Test setup mistake -- variable supposed to"
" not have global binding, but it does."))
- (assert (local-variable-p 'allout-tests-locally-true)
+ (assert (local-variable-p 'allout-tests-locally-true (current-buffer))
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)))
- (assert (local-variable-p 'allout-tests-locally-true))
+ (assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
(assert (equal allout-tests-locally-true nil))
(allout-do-resumptions)
(assert (boundp 'allout-tests-locally-true))
- (assert (local-variable-p 'allout-tests-locally-true))
+ (assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
(assert (equal allout-tests-locally-true t))
(assert (not (default-boundp 'allout-tests-locally-true))))
'(allout-tests-locally-true 4))
;; reestablish many of the basic conditions are maintained after re-add:
(assert (not (default-boundp 'allout-tests-globally-unbound)))
- (assert (local-variable-p 'allout-tests-globally-unbound))
+ (assert (local-variable-p 'allout-tests-globally-unbound (current-buffer)))
(assert (equal allout-tests-globally-unbound 2))
(assert (default-boundp 'allout-tests-globally-true))
- (assert (local-variable-p 'allout-tests-globally-true))
+ (assert (local-variable-p 'allout-tests-globally-true (current-buffer)))
(assert (equal allout-tests-globally-true 3))
(assert (not (default-boundp 'allout-tests-locally-true)))
- (assert (local-variable-p 'allout-tests-locally-true))
+ (assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
(assert (equal allout-tests-locally-true 4))
(allout-do-resumptions)
- (assert (not (local-variable-p 'allout-tests-globally-unbound)))
+ (assert (not (local-variable-p 'allout-tests-globally-unbound
+ (current-buffer))))
(assert (not (boundp 'allout-tests-globally-unbound)))
- (assert (not (local-variable-p 'allout-tests-globally-true)))
+ (assert (not (local-variable-p 'allout-tests-globally-true
+ (current-buffer))))
(assert (boundp 'allout-tests-globally-true))
(assert (equal allout-tests-globally-true t))
(assert (boundp 'allout-tests-locally-true))
- (assert (local-variable-p 'allout-tests-locally-true))
+ (assert (local-variable-p 'allout-tests-locally-true (current-buffer)))
(assert (equal allout-tests-locally-true t))
(assert (not (default-boundp 'allout-tests-locally-true))))
;;allout-layout: (0 : -1 -1 0)
;;End:
-;; arch-tag: cf38fbc3-c044-450f-8bff-afed8ba5681c
;;; allout.el ends here
HCoop / bpt / emacs.git / blobdiff