Use `called-interactively-p' instead of `interactive-p'.
[bpt/emacs.git] / lisp / allout.el
index dd954b7..46ecfed 100644 (file)
@@ -1,7 +1,7 @@
 ;;; 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  Free Software Foundation, Inc.
 
 ;; Author: Ken Manheimer <ken dot manheimer at gmail dot com>
 ;; Maintainer: Ken Manheimer <ken dot manheimer at gmail dot com>
   ;; 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)
-    ))
+  (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)
+  )
 
 ;;;_* USER CUSTOMIZATION VARIABLES:
 
 
 ;;;_  = 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."
@@ -136,7 +135,7 @@ unless optional third, non-nil element is present.")
                                         ; Exposure commands:
         ("\C-i" allout-show-children)
         ("\C-s" allout-show-current-subtree)
-        ("\C-h" allout-hide-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)
@@ -168,7 +167,7 @@ unless optional third, non-nil element is present.")
 
 ;;;_  = 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
@@ -197,7 +196,7 @@ this variable."
   :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
@@ -263,7 +262,7 @@ is modulo the setting of `allout-use-mode-specific-leader', which see."
 
 ;;;_  = 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
@@ -279,7 +278,7 @@ else allout's special hanging-indent maintaining auto-fill function,
 (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."
@@ -292,7 +291,7 @@ 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
@@ -311,7 +310,7 @@ those that do not have the variable `comment-start' set.  A value 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)
@@ -322,7 +321,7 @@ just the header."
 
 ;;;_  = 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.
@@ -353,7 +352,7 @@ repeated calls."
   :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.
@@ -381,7 +380,7 @@ calls."
 (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.
@@ -411,7 +410,7 @@ bullets."
 (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.
@@ -427,7 +426,7 @@ of this var to take effect."
 (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
@@ -476,7 +475,7 @@ strings."
 
 ;;;_  = 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
@@ -527,7 +526,7 @@ from regular comments that start at the beginning-of-line.")
 
 ;;;_  = 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
@@ -543,7 +542,7 @@ are always respected by the topic maneuvering functions."
      (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
@@ -593,7 +592,7 @@ is non-nil."
 
 ;;;_  = 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
@@ -609,7 +608,7 @@ disables numbering maintenance."
        '(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)
@@ -621,7 +620,7 @@ Set this var to the bullet you want to use for file cross-references."
        '(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)
 
@@ -631,7 +630,7 @@ Set this var to the bullet you want to use for file cross-references."
 
 ;;;_  = 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
@@ -640,43 +639,43 @@ numbers are always used."
 ;;;_ + 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)
 
@@ -687,13 +686,13 @@ formatted copy."
   :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.
+  "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."
@@ -703,7 +702,7 @@ variable for details about allout ajustment of file variables."
 (make-variable-buffer-local 'allout-passphrase-verifier-handling)
 ;;;_  = allout-passphrase-hint-handling
 (defcustom allout-passphrase-hint-handling 'always
-  "*Dictate outline encryption passphrase reminder handling:
+  "Dictate outline encryption passphrase reminder handling:
 
  always -- always show reminder when prompting
  needed -- show reminder on passphrase entry failure
@@ -719,7 +718,7 @@ variable for details about allout ajustment of file variables."
 (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.
@@ -758,7 +757,7 @@ disable auto-saves for that file."
   :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.
 
@@ -774,7 +773,7 @@ See `allout-run-unit-tests' to see what's run."
 
 ;;;_  = 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.
@@ -929,14 +928,14 @@ useful at greater depths, more modest doublecheck limits are more
 suitably economical.")
 ;;;_   X allout-reset-header-lead (header-lead)
 (defun allout-reset-header-lead (header-lead)
-  "*Reset the leading string used to identify topic headers."
+  "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."
@@ -1591,7 +1590,7 @@ the following two lines in your Emacs init file:
 \(allout-init t)"
 
   (interactive)
-  (if (interactive-p)
+  (if (called-interactively-p 'interactive)
       (progn
        (setq mode
              (completing-read
@@ -1615,7 +1614,7 @@ the following two lines in your Emacs init file:
     (cond ((not mode)
           (set find-file-hook-var-name
                 (delq hook (symbol-value find-file-hook-var-name)))
-          (if (interactive-p)
+          (if (called-interactively-p 'interactive)
               (message "Allout outline mode auto-activation inhibited.")))
          ((eq mode 'report)
           (if (not (memq hook (symbol-value find-file-hook-var-name)))
@@ -1830,7 +1829,7 @@ single keystroke.  Regular navigation keys (eg, \\[forward-char], \\[next-line])
 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
@@ -2205,10 +2204,10 @@ internal functions use this feature cohesively bunch changes."
                    (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)
@@ -2902,7 +2901,7 @@ of (before any) topics, in which case we return nil."
   (let ((bol-point (point)))
     (if (allout-goto-prefix-doublechecked)
         (if (<= (point) bol-point)
-            (if (interactive-p)
+            (if (called-interactively-p 'interactive)
                 (allout-end-of-prefix)
               (point))
           (goto-char (point-min))
@@ -2969,7 +2968,7 @@ If already there, move cursor to bullet for hot-spot operation.
         (goto-char allout-recent-prefix-end)
       (goto-char (point-min)))
     (allout-end-of-prefix)
-    (if (and (interactive-p)
+    (if (and (called-interactively-p 'interactive)
             (= (point) start-point))
        (goto-char (allout-current-bullet-pos)))))
 ;;;_   > allout-end-of-entry (&optional inclusive)
@@ -3019,7 +3018,7 @@ collapsed."
         (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 (called-interactively-p 'interactive) (allout-end-of-prefix))
         (and last-ascended allout-recent-depth))))
 ;;;_   > allout-ascend ()
 (defun allout-ascend (&optional dont-move-if-unsuccessful)
@@ -3047,7 +3046,7 @@ which case point is returned to its original starting location."
                    (goto-char bolevel)
                    (allout-depth)
                    nil))))
-    (if (interactive-p) (allout-end-of-prefix))))
+    (if (called-interactively-p 'interactive) (allout-end-of-prefix))))
 ;;;_   > allout-descend-to-depth (depth)
 (defun allout-descend-to-depth (depth)
   "Descend to depth DEPTH within current topic.
@@ -3075,7 +3074,7 @@ Returning depth if successful, nil if not."
     (if (not (allout-ascend))
         (progn (goto-char start-point)
                (error "Can't ascend past outermost level"))
-      (if (interactive-p) (allout-end-of-prefix))
+      (if (called-interactively-p 'interactive) (allout-end-of-prefix))
       allout-recent-prefix-beginning)))
 
 ;;;_  - Linear
@@ -3220,7 +3219,7 @@ Presumes point is at the start of a topic prefix."
   (let ((depth (allout-depth)))
     (while (allout-previous-sibling depth nil))
     (prog1 allout-recent-depth
-      (if (interactive-p) (allout-end-of-prefix)))))
+      (if (called-interactively-p 'interactive) (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.
@@ -3273,7 +3272,7 @@ A heading line is one that starts with a `*' (or that `allout-regexp'
 matches)."
   (interactive "p")
   (prog1 (allout-next-visible-heading (- arg))
-    (if (interactive-p) (allout-end-of-prefix))))
+    (if (called-interactively-p 'interactive) (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.
@@ -3294,7 +3293,7 @@ Returns resulting position, else nil if none found."
                     (allout-previous-sibling)
                   (allout-next-sibling)))
       (setq arg (1- arg)))
-    (if (not (interactive-p))
+    (if (not (called-interactively-p 'interactive))
         nil
       (allout-end-of-prefix)
       (if (not (zerop arg))
@@ -3307,7 +3306,7 @@ Returns resulting position, else nil if none found."
 (defun allout-backward-current-level (arg)
   "Inverse of `allout-forward-current-level'."
   (interactive "p")
-  (if (interactive-p)
+  (if (called-interactively-p 'interactive)
       (let ((current-prefix-arg (* -1 arg)))
        (call-interactively 'allout-forward-current-level))
     (allout-forward-current-level (* -1 arg))))
@@ -3392,13 +3391,13 @@ this-command accordingly.
 
 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* ((key-string (if (numberp last-command-event)
+                         (char-to-string 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)
 
@@ -4846,7 +4845,7 @@ point of non-opened subtree?)"
                  (to-reveal (or (allout-chart-to-reveal chart chart-level)
                                 ;; interactive, show discontinuous children:
                                 (and chart
-                                     (interactive-p)
+                                     (called-interactively-p 'interactive)
                                      (save-excursion
                                        (allout-back-to-current-heading)
                                        (setq depth (allout-current-depth))
@@ -6334,7 +6333,7 @@ of the availability of a cached copy."
                                 nil)
                             t))
                      (progn (pgg-remove-passphrase-from-cache cache-id t)
-                            (error "Wrong passphrase."))))
+                            (error "Wrong passphrase"))))
                 ;; No verifier string -- force confirmation by repetition of
                 ;; (new) passphrase:
                 ((or fetch-pass (not cached))
@@ -6356,7 +6355,7 @@ of the availability of a cached copy."
                          ;; recurse to this routine:
                          (pgg-read-passphrase prompt-sans-hint cache-id t))
                 (pgg-remove-passphrase-from-cache cache-id t)
-                (error "Confirmation failed."))))))))
+                (error "Confirmation failed"))))))))
 ;;;_  > allout-encrypted-topic-p ()
 (defun allout-encrypted-topic-p ()
   "True if the current topic is encryptable and encrypted."