update from main archive 970417libc20x-970417glibc-2_0_4

38 files changed, 0 insertions, 28980 deletions

diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
deleted file mode 100644
index dabff28ae3a..00000000000
--- a/lisp/emacs-lisp/advice.el
+++ /dev/null
@@ -1,3960 +0,0 @@
-;;; advice.el --- an overloading mechanism for Emacs Lisp functions
-
-;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: Hans Chalupsky <hans@cs.buffalo.edu>
-;; Created: 12 Dec 1992
-;; Version: advice.el,v 2.14 1994/08/05 03:42:04 hans Exp
-;; Keywords: extensions, lisp, tools
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;; LCD Archive Entry:
-;; advice|Hans Chalupsky|hans@cs.buffalo.edu|
-;; Overloading mechanism for Emacs Lisp functions|
-;; 1994/08/05 03:42:04|2.14|~/packages/advice.el.Z|
-
-
-;;; Commentary:
-
-;; NOTE: This documentation is slightly out of date. In particular, all the
-;; references to Emacs-18 are obsolete now, because it is not any longer
-;; supported by this version of Advice. An up-to-date version will soon be
-;; available as an info file (thanks to the kind help of Jack Vinson and
-;; David M. Smith).
-
-;; @ Introduction:
-;; ===============
-;; This package implements a full-fledged Lisp-style advice mechanism
-;; for Emacs Lisp. Advice is a clean and efficient way to modify the 
-;; behavior of Emacs Lisp functions without having to keep  personal
-;; modified copies of such functions around. A great number of such 
-;; modifications can be achieved by treating the original function as a 
-;; black box and specifying a different execution environment for it 
-;; with a piece of advice. Think of a piece of advice as a kind of fancy
-;; hook that you can attach to any function/macro/subr.
-
-;; @ Highlights:
-;; =============
-;; - Clean definition of multiple, named before/around/after advices
-;;   for functions, macros, subrs and special forms
-;; - Full control over the arguments an advised function will receive,
-;;   the binding environment in which it will be executed, as well as the
-;;   value it will return.
-;; - Allows re/definition of interactive behavior for functions and subrs
-;; - Every piece of advice can have its documentation string which will be 
-;;   combined with the original documentation of the advised function at
-;;   call-time of `documentation' for proper command-key substitution.
-;; - The execution of every piece of advice can be protected against error
-;;   and non-local exits in preceding code or advices.
-;; - Simple argument access either by name, or, more portable but as
-;;   efficient, via access macros
-;; - Allows the specification of a different argument list for the advised
-;;   version of a function.
-;; - Advised functions can be byte-compiled either at file-compile time
-;;   (see preactivation) or activation time.
-;; - Separation of advice definition and activation
-;; - Forward advice is possible, that is
-;;   as yet undefined or autoload functions can be advised without having to
-;;   preload the file in which they are defined. 
-;; - Forward redefinition is possible because around advice can be used to
-;;   completely redefine a function.
-;; - A caching mechanism for advised definition provides for cheap deactivation
-;;   and reactivation of advised functions.
-;; - Preactivation allows efficient construction and compilation of advised
-;;   definitions at file compile time without giving up the flexibility of
-;;   the advice mechanism.
-;; - En/disablement mechanism allows the use of  different "views" of advised
-;;   functions depending on what pieces of advice are currently en/disabled
-;; - Provides manipulation mechanisms for sets of advised functions via 
-;;   regular expressions that match advice names
-
-;; @ How to get Advice for Emacs-18:
-;; =================================
-;; `advice18.el', a version of Advice that also works in Emacs-18 is available
-;; either via anonymous ftp from `ftp.cs.buffalo.edu (128.205.32.9)' with 
-;; pathname `/pub/Emacs/advice18.el', or from one of the Emacs Lisp archive
-;; sites, or send email to <hans@cs.buffalo.edu> and I'll mail it to you.
-
-;; @ Overview, or how to read this file:
-;; =====================================
-;; NOTE: This documentation is slightly out of date. In particular, all the
-;; references to Emacs-18 are obsolete now, because it is not any longer
-;; supported by this version of Advice. An up-to-date version will soon be
-;; available as an info file (thanks to the kind help of Jack Vinson and
-;; David M. Smith). Until then you can use `outline-mode' to help you read
-;; this documentation (set `outline-regexp' to `";; @+"').
-;;
-;; The four major sections of this file are:
-;;
-;;   @ This initial information       ...installation, customization etc.
-;;   @ Advice documentation:          ...general documentation
-;;   @ Foo games: An advice tutorial  ...teaches about Advice by example
-;;   @ Advice implementation:         ...actual code, yeah!!
-;;
-;; The latter three are actual headings which you can search for
-;; directly in case `outline-mode' doesn't work for you.
-
-;; @ Restrictions:
-;; ===============
-;; - This version of Advice only works for Emacs 19.26 and later. It uses
-;;   new versions of the built-in functions `fset/defalias' which are not
-;;   yet available in Lucid Emacs, hence, it won't work there.
-;; - Advised functions/macros/subrs will only exhibit their advised behavior
-;;   when they are invoked via their function cell. This means that advice will
-;;   not work for the following:
-;;   + advised subrs that are called directly from other subrs or C-code 
-;;   + advised subrs that got replaced with their byte-code during 
-;;     byte-compilation (e.g., car)
-;;   + advised macros which were expanded during byte-compilation before
-;;     their advice was activated.
-
-;; @ Credits:
-;; ==========
-;; This package is an extension and generalization of packages such as
-;; insert-hooks.el written by Noah S. Friedman, and advise.el written by
-;; Raul J. Acevedo. Some ideas used in here come from these packages,
-;; others come from the various Lisp advice mechanisms I've come across
-;; so far, and a few are simply mine.
-
-;; @ Comments, suggestions, bug reports:
-;; =====================================
-;; If you find any bugs, have suggestions for new advice features, find the
-;; documentation wrong, confusing, incomplete, or otherwise unsatisfactory,
-;; have any questions about Advice, or have otherwise enlightening
-;; comments feel free to send me email at <hans@cs.buffalo.edu>.
-
-;; @ Safety Rules and Emergency Exits:
-;; ===================================
-;; Before we begin: CAUTION!!
-;; Advice provides you with a lot of rope to hang yourself on very
-;; easily accessible trees, so, here are a few important things you
-;; should know: Once Advice has been started with `ad-start-advice'
-;; (which happens automatically when you load this file), it
-;; generates an advised definition of the `documentation' function, and
-;; it will enable automatic advice activation when functions get defined.
-;; All of this can be undone at any time with `M-x ad-stop-advice'.
-;; 
-;; If you experience any strange behavior/errors etc. that you attribute to
-;; Advice or to some ill-advised function do one of the following:
-
-;; - M-x ad-deactivate FUNCTION (if you have a definite suspicion what
-;;                               function gives you problems)
-;; - M-x ad-deactivate-all      (if you don't have a clue what's going wrong)
-;; - M-x ad-stop-advice         (if you think the problem is related to the
-;;                               advised functions used by Advice itself)
-;; - M-x ad-recover-normality   (for real emergencies)
-;; - If none of the above solves your Advice-related problem go to another
-;;   terminal, kill your Emacs process and send me some hate mail.
-
-;; The first three measures have restarts, i.e., once you've figured out
-;; the problem you can reactivate advised functions with either `ad-activate',
-;; `ad-activate-all', or `ad-start-advice'. `ad-recover-normality' unadvises
-;; everything so you won't be able to reactivate any advised functions, you'll
-;; have to stick with their standard incarnations for the rest of the session.
-
-;; IMPORTANT: With Advice loaded always do `M-x ad-deactivate-all' before
-;; you byte-compile a file, because advised special forms and macros can lead
-;; to unwanted compilation results. When you are done compiling use
-;; `M-x ad-activate-all' to go back to the advised state of all your 
-;; advised functions.
-
-;; RELAX: Advice is pretty safe even if you are oblivious to the above.
-;; I use it extensively and haven't run into any serious trouble in a long
-;; time. Just wanted you to be warned.
-
-;; @ Customization:
-;; ================
-
-;; Look at the documentation of `ad-redefinition-action' for possible values
-;; of this variable. Its default value is `warn' which will print a warning
-;; message when an already defined advised function gets redefined with a
-;; new original definition and de/activated.
-
-;; Look at the documentation of `ad-default-compilation-action' for possible
-;; values of this variable. Its default value is `maybe' which will compile
-;; advised definitions during activation in case the byte-compiler is already
-;; loaded. Otherwise, it will leave them uncompiled.
-
-;; @ Motivation:
-;; =============
-;; Before I go on explaining how advice works, here are four simple examples
-;; how this package can be used. The first three are very useful, the last one
-;; is just a joke:
-
-;;(defadvice switch-to-buffer (before existing-buffers-only activate)
-;;  "When called interactively switch to existing buffers only, unless 
-;;when called with a prefix argument."
-;;  (interactive 
-;;   (list (read-buffer "Switch to buffer: " (other-buffer) 
-;;                      (null current-prefix-arg)))))
-;;
-;;(defadvice switch-to-buffer (around confirm-non-existing-buffers activate)
-;;  "Switch to non-existing buffers only upon confirmation."
-;;  (interactive "BSwitch to buffer: ")
-;;  (if (or (get-buffer (ad-get-arg 0))
-;;          (y-or-n-p (format "`%s' does not exist, create? " (ad-get-arg 0))))
-;;      ad-do-it))
-;;
-;;(defadvice find-file (before existing-files-only activate)
-;;  "Find existing files only"
-;;  (interactive "fFind file: "))
-;;
-;;(defadvice car (around interactive activate)
-;;  "Make `car' an interactive function."
-;;   (interactive "xCar of list: ")
-;;   ad-do-it
-;;   (if (interactive-p)
-;;       (message "%s" ad-return-value)))
-
-
-;; @ Advice documentation:
-;; =======================
-;; Below is general documentation of the various features of advice. For more
-;; concrete examples check the corresponding sections in the tutorial part.
-
-;; @@ Terminology:
-;; ===============
-;; - Emacs, Emacs-19: FSF's version of Emacs with major version 19
-;; - Lemacs: Lucid's version of Emacs with major version 19
-;; - v18: Any Emacs with major version 18 or built as an extension to that
-;;        (such as Epoch)
-;; - v19: Any Emacs with major version 19
-;; - jwz: Jamie Zawinski - keeper of Lemacs and creator of the optimizing
-;;        byte-compiler used in v19s.
-;; - Advice: The name of this package.
-;; - advices: Short for "pieces of advice".
-
-;; @@ Defining a piece of advice with `defadvice':
-;; ===============================================
-;; The main means of defining a piece of advice is the macro `defadvice',
-;; there is no interactive way of specifying a piece of advice.  A call to
-;; `defadvice' has the following syntax which is similar to the syntax of
-;; `defun/defmacro':
-;;
-;; (defadvice <function> (<class> <name> [<position>] [<arglist>] {<flags>}*)
-;;   [ [<documentation-string>] [<interactive-form>] ]
-;;   {<body-form>}* )
-
-;; <function> is the name of the function/macro/subr to be advised.
-
-;; <class> is the class of the advice which has to be one of `before',
-;; `around', `after', `activation' or `deactivation' (the last two allow
-;; definition of special act/deactivation hooks).
-
-;; <name> is the name of the advice which has to be a non-nil symbol.
-;; Names uniquely identify a piece of advice in a certain advice class,
-;; hence, advices can be redefined by defining an advice with the same class
-;; and name. Advice names are global symbols, hence, the same name space
-;; conventions used for function names should be applied.
-
-;; An optional <position> specifies where in the current list of advices of
-;; the specified <class> this new advice will be placed. <position> has to
-;; be either `first', `last' or a number that specifies a zero-based
-;; position (`first' is equivalent to 0). If no position is specified
-;; `first' will be used as a default. If this call to `defadvice' redefines
-;; an already existing advice (see above) then the position argument will
-;; be ignored and the position of the already existing advice will be used.
-
-;; An optional <arglist> which has to be a list can be used to define the
-;; argument list of the advised function. This argument list should of
-;; course be compatible with the argument list of the original function,
-;; otherwise functions that call the advised function with the original
-;; argument list in mind will break. If more than one advice specify an
-;; argument list then the first one (the one with the smallest position)
-;; found in the list of before/around/after advices will be used.
-
-;; <flags> is a list of symbols that specify further information about the
-;; advice. All flags can be specified with unambiguous initial substrings.
-;;   `activate': Specifies that the advice information of the advised
-;;              function should be activated right after this advice has been
-;;              defined. In forward advices `activate' will be ignored. 
-;;   `protect': Specifies that this advice should be protected against
-;;              non-local exits and errors in preceding code/advices.
-;;   `compile': Specifies that the advised function should be byte-compiled.
-;;              This flag will be ignored unless `activate' is also specified.
-;;   `disable': Specifies that the defined advice should be disabled, hence,
-;;              it will not be used in an activation until somebody enables it.
-;;   `preactivate': Specifies that the advised function should get preactivated
-;;              at macro-expansion/compile time of this `defadvice'. This
-;;              generates a compiled advised definition according to the
-;;              current advice state which will be used during activation
-;;              if appropriate. Only use this if the `defadvice' gets
-;;              actually compiled (with a v18 byte-compiler put the `defadvice'
-;;              into the body of a `defun' to accomplish proper compilation).
-
-;; An optional <documentation-string> can be supplied to document the advice.
-;; On call of the `documentation' function it will be combined with the
-;; documentation strings of the original function and other advices.
-
-;; An optional <interactive-form> form can be supplied to change/add
-;; interactive behavior of the original function. If more than one advice
-;; has an `(interactive ...)' specification then the first one (the one
-;; with the smallest position) found in the list of before/around/after
-;; advices will be used.
-
-;; A possibly empty list of <body-forms> specifies the body of the advice in
-;; an implicit progn. The body of an advice can access/change arguments,
-;; the return value, the binding environment, and can have all sorts of 
-;; other side effects.
-
-;; @@ Assembling advised definitions:
-;; ==================================
-;; Suppose a function/macro/subr/special-form has N pieces of before advice,
-;; M pieces of around advice and K pieces of after advice. Assuming none of
-;; the advices is protected, its advised definition will look like this
-;; (body-form indices correspond to the position of the respective advice in
-;; that advice class):
-
-;;    ([macro] lambda <arglist>
-;;       [ [<advised-docstring>] [(interactive ...)] ]
-;;       (let (ad-return-value)
-;;         {<before-0-body-form>}*
-;;               ....
-;;         {<before-N-1-body-form>}*
-;;         {<around-0-body-form>}*
-;;            {<around-1-body-form>}*
-;;                  ....
-;;               {<around-M-1-body-form>}*
-;;                  (setq ad-return-value
-;;                        <apply original definition to <arglist>>)
-;;               {<other-around-M-1-body-form>}*
-;;                  ....
-;;            {<other-around-1-body-form>}*
-;;         {<other-around-0-body-form>}*
-;;         {<after-0-body-form>}*
-;;               ....
-;;         {<after-K-1-body-form>}*
-;;         ad-return-value))
-
-;; Macros and special forms will be redefined as macros, hence the optional
-;; [macro] in the beginning of the definition.
-
-;; <arglist> is either the argument list of the original function or the
-;; first argument list defined in the list of before/around/after advices.
-;; The values of <arglist> variables can be accessed/changed in the body of
-;; an advice by simply referring to them by their original name, however,
-;; more portable argument access macros are also provided (see below).  For
-;; subrs/special-forms for which neither explicit argument list definitions
-;; are available, nor their documentation strings contain such definitions
-;; (as they do v19s), `(&rest ad-subr-args)' will be used.
-
-;; <advised-docstring> is an optional, special documentation string which will
-;; be expanded into a proper documentation string upon call of `documentation'.
-
-;; (interactive ...) is an optional interactive form either taken from the
-;; original function or from a before/around/after advice. For advised
-;; interactive subrs that do not have an interactive form specified in any
-;; advice we have to use (interactive) and then call the subr interactively
-;; if the advised function was called interactively, because the
-;; interactive specification of subrs is not accessible. This is the only
-;; case where changing the values of arguments will not have an affect
-;; because they will be reset by the interactive specification of the subr.
-;; If this is a problem one can always specify an interactive form in a
-;; before/around/after advice to gain control over argument values that
-;; were supplied interactively.
-;; 
-;; Then the body forms of the various advices in the various classes of advice
-;; are assembled in order.  The forms of around advice L are normally part of
-;; one of the forms of around advice L-1. An around advice can specify where
-;; the forms of the wrapped or surrounded forms should go with the special
-;; keyword `ad-do-it', which will be substituted with a `progn' containing the
-;; forms of the surrounded code.
-
-;; The innermost part of the around advice onion is 
-;;      <apply original definition to <arglist>>
-;; whose form depends on the type of the original function. The variable
-;; `ad-return-value' will be set to its result. This variable is visible to
-;; all pieces of advice which can access and modify it before it gets returned.
-;; 
-;; The semantic structure of advised functions that contain protected pieces
-;; of advice is the same. The only difference is that `unwind-protect' forms
-;; make sure that the protected advice gets executed even if some previous
-;; piece of advice had an error or a non-local exit. If any around advice is
-;; protected then the whole around advice onion will be protected.
-
-;; @@ Argument access in advised functions:
-;; ========================================
-;; As already mentioned, the simplest way to access the arguments of an
-;; advised function in the body of an advice is to refer to them by name. To
-;; do that, the advice programmer needs to know either the names of the
-;; argument variables of the original function, or the names used in the
-;; argument list redefinition given in a piece of advice. While this simple
-;; method might be sufficient in many cases, it has the disadvantage that it
-;; is not very portable because it hardcodes the argument names into the
-;; advice. If the definition of the original function changes the advice
-;; might break even though the code might still be correct. Situations like
-;; that arise, for example, if one advises a subr like `eval-region' which
-;; gets redefined in a non-advice style into a function by the edebug
-;; package. If the advice assumes `eval-region' to be a subr it might break
-;; once edebug is loaded. Similar situations arise when one wants to use the
-;; same piece of advice across different versions of Emacs. Some subrs in a
-;; v18 Emacs are functions in v19 and vice versa, but for the most part the
-;; semantics remain the same, hence, the same piece of advice might be usable
-;; in both Emacs versions.
-
-;; As a solution to that advice provides argument list access macros that get
-;; translated into the proper access forms at activation time, i.e., when the
-;; advised definition gets constructed. Access macros access actual arguments
-;; by position regardless of how these actual argument get distributed onto
-;; the argument variables of a function. The rational behind this is that in
-;; Emacs Lisp the semantics of an argument is strictly determined by its
-;; position (there are no keyword arguments).
-
-;; Suppose the function `foo' is defined as
-;;
-;;    (defun foo (x y &optional z &rest r) ....)
-;;
-;; and is then called with
-;;
-;;    (foo 0 1 2 3 4 5 6)
-
-;; which means that X=0, Y=1, Z=2 and R=(3 4 5 6). The assumption is that
-;; the semantics of an actual argument is determined by its position. It is
-;; this semantics that has to be known by the advice programmer. Then s/he
-;; can access these arguments in a piece of advice with some of the
-;; following macros (the arrows indicate what value they will return):
-
-;;    (ad-get-arg 0) -> 0
-;;    (ad-get-arg 1) -> 1
-;;    (ad-get-arg 2) -> 2
-;;    (ad-get-arg 3) -> 3
-;;    (ad-get-args 2) -> (2 3 4 5 6)
-;;    (ad-get-args 4) -> (4 5 6)
-
-;; `(ad-get-arg <position>)' will return the actual argument that was supplied
-;; at <position>, `(ad-get-args <position>)' will return the list of actual
-;; arguments supplied starting at <position>. Note that these macros can be
-;; used without any knowledge about the form of the actual argument list of
-;; the original function.
-
-;; Similarly, `(ad-set-arg <position> <value-form>)' can be used to set the
-;; value of the actual argument at <position> to <value-form>. For example,
-;;
-;;   (ad-set-arg 5 "five")
-;;
-;; will have the effect that R=(3 4 "five" 6) once the original function is
-;; called. `(ad-set-args <position> <value-list-form>)' can be used to set
-;; the list of actual arguments starting at <position> to <value-list-form>.
-;; For example,
-;;
-;;   (ad-set-args 0 '(5 4 3 2 1 0))
-;;
-;; will have the effect that X=5, Y=4, Z=3 and R=(2 1 0) once the original
-;; function is called.
-
-;; All these access macros are text macros rather than real Lisp macros. When
-;; the advised definition gets constructed they get replaced with actual access
-;; forms depending on the argument list of the advised function, i.e., after
-;; that argument access is in most cases as efficient as using the argument
-;; variable names directly.
-
-;; @@@ Accessing argument bindings of arbitrary functions:
-;; =======================================================
-;; Some functions (such as `trace-function' defined in trace.el) need a
-;; method of accessing the names and bindings of the arguments of an
-;; arbitrary advised function. To do that within an advice one can use the
-;; special keyword `ad-arg-bindings' which is a text macro that will be
-;; substituted with a form that will evaluate to a list of binding
-;; specifications, one for every argument variable.  These binding
-;; specifications can then be examined in the body of the advice.  For
-;; example, somewhere in an advice we could do this:
-;;
-;;   (let* ((bindings ad-arg-bindings)
-;;          (firstarg (car bindings))
-;;          (secondarg (car (cdr bindings))))
-;;     ;; Print info about first argument
-;;     (print (format "%s=%s (%s)"
-;;                    (ad-arg-binding-field firstarg 'name)
-;;                    (ad-arg-binding-field firstarg 'value)
-;;                    (ad-arg-binding-field firstarg 'type)))
-;;     ....)
-;;
-;; The `type' of an argument is either `required', `optional' or `rest'.
-;; Wherever `ad-arg-bindings' appears a form will be inserted that evaluates
-;; to the list of bindings, hence, in order to avoid multiple unnecessary
-;; evaluations one should always bind it to some variable.
-
-;; @@@ Argument list mapping:
-;; ==========================
-;; Because `defadvice' allows the specification of the argument list of the
-;; advised function we need a mapping mechanism that maps this argument list
-;; onto that of the original function. For example, somebody might specify
-;; `(sym newdef)' as the argument list of `fset', while advice might use
-;; `(&rest ad-subr-args)' as the argument list of the original function
-;; (depending on what Emacs version is used). Hence SYM and NEWDEF have to
-;; be properly mapped onto the &rest variable when the original definition is
-;; called. Advice automatically takes care of that mapping, hence, the advice 
-;; programmer can specify an argument list without having to know about the
-;; exact structure of the original argument list as long as the new argument
-;; list takes a compatible number/magnitude of actual arguments.
-
-;; @@@ Definition of subr argument lists:
-;; ======================================
-;; When advice constructs the advised definition of a function it has to
-;; know the argument list of the original function. For functions and macros
-;; the argument list can be determined from the actual definition, however,
-;; for subrs there is no such direct access available. In Lemacs and for some
-;; subrs in Emacs-19 the argument list of a subr can be determined from
-;; its documentation string, in a v18 Emacs even that is not possible. If
-;; advice cannot at all determine the argument list of a subr it uses
-;; `(&rest ad-subr-args)' which will always work but is inefficient because
-;; it conses up arguments. The macro `ad-define-subr-args' can be used by
-;; the advice programmer to explicitly tell advice about the argument list
-;; of a certain subr, for example,
-;;
-;;    (ad-define-subr-args 'fset '(sym newdef))
-;;
-;; is used by advice itself to tell a v18 Emacs about the arguments of `fset'.
-;; The following can be used to undo such a definition:
-;;
-;;    (ad-undefine-subr-args 'fset)
-;;
-;; The argument list definition is stored on the property list of the subr
-;; name symbol. When an argument list could be determined from the
-;; documentation string it will be cached under that property. The general
-;; mechanism for looking up the argument list of a subr is the following:
-;; 1) look for a definition stored on the property list
-;; 2) if that failed try to infer it from the documentation string and
-;;    if successful cache it on the property list
-;; 3) otherwise use `(&rest ad-subr-args)'
-
-;; @@ Activation and deactivation:
-;; ===============================
-;; The definition of an advised function does not change until all its advice
-;; gets actually activated. Activation can either happen with the `activate'
-;; flag specified in the `defadvice', with an explicit call or interactive
-;; invocation of `ad-activate', or if forward advice is enabled (i.e., the
-;; value of `ad-activate-on-definition' is t) at the time an already advised
-;; function gets defined.
-
-;; When a function gets first activated its original definition gets saved,
-;; all defined and enabled pieces of advice will get combined with the
-;; original definition, the resulting definition might get compiled depending
-;; on some conditions described below, and then the function will get
-;; redefined with the advised definition.  This also means that undefined
-;; functions cannot get activated even though they might be already advised.
-
-;; The advised definition will get compiled either if `ad-activate' was called
-;; interactively with a prefix argument, or called explicitly with its second
-;; argument as t, or, if `ad-default-compilation-action' justifies it according
-;; to the current system state. If the advised definition was
-;; constructed during "preactivation" (see below) then that definition will
-;; be already compiled because it was constructed during byte-compilation of
-;; the file that contained the `defadvice' with the `preactivate' flag.
-
-;; `ad-deactivate' can be used to back-define an advised function to its
-;; original definition. It can be called interactively or directly. Because
-;; `ad-activate' caches the advised definition the function can be
-;; reactivated via `ad-activate' with only minor overhead (it is checked
-;; whether the current advice state is consistent with the cached
-;; definition, see the section on caching below).
-
-;; `ad-activate-regexp' and `ad-deactivate-regexp' can be used to de/activate
-;; all currently advised function that have a piece of advice with a name that
-;; contains a match for a regular expression. These functions can be used to
-;; de/activate sets of functions depending on certain advice naming
-;; conventions.
-
-;; Finally, `ad-activate-all' and `ad-deactivate-all' can be used to
-;; de/activate all currently advised functions. These are useful to
-;; (temporarily) return to an un/advised state.
-
-;; @@@ Reasons for the separation of advice definition and activation:
-;; ===================================================================
-;; As already mentioned, advising happens in two stages:
-
-;;   1) definition of various pieces of advice
-;;   2) activation of all advice currently defined and enabled
-
-;; The advantage of this is that various pieces of advice can be defined
-;; before they get combined into an advised definition which avoids
-;; unnecessary constructions of intermediate advised definitions. The more
-;; important advantage is that it allows the implementation of forward advice.
-;; Advice information for a certain function accumulates as the value of the
-;; `advice-info' property of the function symbol. This accumulation is
-;; completely independent of the fact that that function might not yet be
-;; defined. The special forms `defun' and `defmacro' have been advised to
-;; check whether the function/macro they defined had advice information
-;; associated with it. If so and forward advice is enabled, the original
-;; definition will be saved, and then the advice will be activated. When a
-;; file is loaded in a v18 Emacs the functions/macros it defines are also
-;; defined with calls to `defun/defmacro'.  Hence, we can forward advise
-;; functions/macros which will be defined later during a load/autoload of some
-;; file (for compiled files generated by jwz's byte-compiler in a v19 Emacs
-;; this is slightly more complicated but the basic idea is the same).
-
-;; @@ Enabling/disabling pieces or sets of advice:
-;; ===============================================
-;; A major motivation for the development of this advice package was to bring
-;; a little bit more structure into the function overloading chaos in Emacs
-;; Lisp. Many packages achieve some of their functionality by adding a little
-;; bit (or a lot) to the standard functionality of some Emacs Lisp function.
-;; ange-ftp is a very popular package that achieves its magic by overloading
-;; most Emacs Lisp functions that deal with files. A popular function that's
-;; overloaded by many packages is `expand-file-name'. The situation that one
-;; function is multiply overloaded can arise easily.
-
-;; Once in a while it would be desirable to be able to disable some/all
-;; overloads of a particular package while keeping all the rest.  Ideally -
-;; at least in my opinion - these overloads would all be done with advice,
-;; I know I am dreaming right now... In that ideal case the enable/disable
-;; mechanism of advice could be used to achieve just that.
-
-;; Every piece of advice is associated with an enablement flag. When the
-;; advised definition of a particular function gets constructed (e.g., during
-;; activation) only the currently enabled pieces of advice will be considered.
-;; This mechanism allows one to have different "views" of an advised function
-;; dependent on what pieces of advice are currently enabled.
-
-;; Another motivation for this mechanism is that it allows one to define a
-;; piece of advice for some function yet keep it dormant until a certain
-;; condition is met. Until then activation of the function will not make use
-;; of that piece of advice. Once the condition is met the advice can be
-;; enabled and a reactivation of the function will add its functionality as
-;; part of the new advised definition. For example, the advices of `defun'
-;; etc. used by advice itself will stay disabled until `ad-start-advice' is
-;; called and some variables have the proper values.  Hence, if somebody
-;; else advised these functions too and activates them the advices defined
-;; by advice will get used only if they are intended to be used.
-
-;; The main interface to this mechanism are the interactive functions
-;; `ad-enable-advice' and `ad-disable-advice'. For example, the following
-;; would disable a particular advice of the function `foo':
-;;
-;;    (ad-disable-advice 'foo 'before 'my-advice)
-;;
-;; This call by itself only changes the flag, to get the proper effect in
-;; the advised definition too one has to activate `foo' with
-;;
-;;    (ad-activate 'foo)
-;;
-;; or interactively. To disable whole sets of advices one can use a regular
-;; expression mechanism. For example, let us assume that ange-ftp actually
-;; used advice to overload all its functions, and that it used the
-;; "ange-ftp-" prefix for all its advice names, then we could temporarily
-;; disable all its advices with
-;;
-;;    (ad-disable-regexp "^ange-ftp-")
-;;
-;; and the following call would put that actually into effect:
-;;
-;;    (ad-activate-regexp "^ange-ftp-")
-;;
-;; A saver way would have been to use
-;;
-;;    (ad-update-regexp "^ange-ftp-")
-;;
-;; instead which would have only reactivated currently actively advised
-;; functions, but not functions that were currently deactivated. All these
-;; functions can also be called interactively.
-
-;; A certain piece of advice is considered a match if its name contains a
-;; match for the regular expression. To enable ange-ftp again we would use
-;; `ad-enable-regexp' and then activate or update again.
-
-;; @@ Forward advice, automatic advice activation:
-;; ===============================================
-;; Because most Emacs Lisp packages are loaded on demand via an autoload
-;; mechanism it is essential to be able to "forward advise" functions.
-;; Otherwise, proper advice definition and activation would make it necessary
-;; to preload every file that defines a certain function before it can be
-;; advised, which would partly defeat the purpose of the advice mechanism.
-
-;; In the following, "forward advice" always implies its automatic activation
-;; once a function gets defined, and not just the accumulation of advice
-;; information for a possibly undefined function.
-
-;; Advice implements forward advice mainly via the following: 1) Separation
-;; of advice definition and activation that makes it possible to accumulate
-;; advice information without having the original function already defined,
-;; 2) special versions of the built-in functions `fset/defalias' which check
-;; for advice information whenever they define a function. If advice
-;; information was found then the advice will immediately get activated when
-;; the function gets defined.
-
-;; Automatic advice activation means, that whenever a function gets defined
-;; with either `defun', `defmacro', `fset' or by loading a byte-compiled
-;; file, and the function has some advice-info stored with it then that
-;; advice will get activated right away.
-
-;; @@@ Enabling automatic advice activation:
-;; =========================================
-;; Automatic advice activation is enabled by default. It can be disabled by
-;; doint `M-x ad-stop-advice' and enabled again with `M-x ad-start-advice'.
-
-;; @@ Caching of advised definitions:
-;; ==================================
-;; After an advised definition got constructed it gets cached as part of the
-;; advised function's advice-info so it can be reused, for example, after an
-;; intermediate deactivation. Because the advice-info of a function might
-;; change between the time of caching and reuse a cached definition gets
-;; a cache-id associated with it so it can be verified whether the cached
-;; definition is still valid (the main application of this is preactivation
-;; - see below).
-
-;; When an advised function gets activated and a verifiable cached definition
-;; is available, then that definition will be used instead of creating a new
-;; advised definition from scratch. If you want to make sure that a new
-;; definition gets constructed then you should use `ad-clear-cache' before you
-;; activate the advised function.
-
-;; @@ Preactivation:
-;; =================
-;; Constructing an advised definition is moderately expensive. In a situation
-;; where one package defines a lot of advised functions it might be
-;; prohibitively expensive to do all the advised definition construction at
-;; runtime. Preactivation is a mechanism that allows compile-time construction
-;; of compiled advised definitions that can be activated cheaply during
-;; runtime. Preactivation uses the caching mechanism to do that. Here's how it
-;; works:
-
-;; When the byte-compiler compiles a `defadvice' that has the `preactivate'
-;; flag specified, it uses the current original definition of the advised
-;; function plus the advice specified in this `defadvice' (even if it is
-;; specified as disabled) and all other currently enabled pieces of advice to
-;; construct an advised definition and an identifying cache-id and makes them
-;; part of the `defadvice' expansion which will then be compiled by the
-;; byte-compiler (to ensure that in a v18 emacs you have to put the
-;; `defadvice' inside a `defun' to get it compiled and then you have to call
-;; that compiled `defun' in order to actually execute the `defadvice'). When
-;; the file with the compiled, preactivating `defadvice' gets loaded the
-;; precompiled advised definition will be cached on the advised function's
-;; advice-info. When it gets activated (can be immediately on execution of the
-;; `defadvice' or any time later) the cache-id gets checked against the
-;; current state of advice and if it is verified the precompiled definition
-;; will be used directly (the verification is pretty cheap). If it couldn't get
-;; verified a new advised definition for that function will be built from
-;; scratch, hence, the efficiency added by the preactivation mechanism does
-;; not at all impair the flexibility of the advice mechanism.
-
-;; MORAL: In order get all the efficiency out of preactivation the advice
-;;        state of an advised function at the time the file with the
-;;        preactivating `defadvice' gets byte-compiled should be exactly
-;;        the same as it will be when the advice of that function gets
-;;        actually activated. If it is not there is a high chance that the
-;;        cache-id will not match and hence a new advised definition will
-;;        have to be constructed at runtime.
-
-;; Preactivation and forward advice do not contradict each other. It is
-;; perfectly ok to load a file with a preactivating `defadvice' before the
-;; original definition of the advised function is available. The constructed
-;; advised definition will be used once the original function gets defined and
-;; its advice gets activated. The only constraint is that at the time the
-;; file with the preactivating `defadvice' got compiled the original function
-;; definition was available.
-
-;; TIPS: Here are some indications that a preactivation did not work the way
-;;       you intended it to work:
-;;       - Activation of the advised function takes longer than usual/expected
-;;       - The byte-compiler gets loaded while an advised function gets
-;;         activated
-;;       - `byte-compile' is part of the `features' variable even though you
-;;         did not use the byte-compiler
-;;       Right now advice does not provide an elegant way to find out whether
-;;       and why a preactivation failed. What you can do is to trace the
-;;       function `ad-cache-id-verification-code' (with the function
-;;       `trace-function-background' defined in my trace.el package) before
-;;       any of your advised functions get activated. After they got
-;;       activated check whether all calls to `ad-cache-id-verification-code'
-;;       returned `verified' as a result. Other values indicate why the
-;;       verification failed which should give you enough information to
-;;       fix your preactivation/compile/load/activation sequence.
-
-;; IMPORTANT: There is one case (that I am aware of) that can make 
-;; preactivation fail, i.e., a preconstructed advised definition that does
-;; NOT match the current state of advice gets used nevertheless. That case
-;; arises if one package defines a certain piece of advice which gets used
-;; during preactivation, and another package incompatibly redefines that 
-;; very advice (i.e., same function/class/name), and it is the second advice
-;; that is available when the preconstructed definition gets activated, and
-;; that was the only definition of that advice so far (`ad-add-advice' 
-;; catches advice redefinitions and clears the cache in such a case). 
-;; Catching that would make the cache verification too expensive.
-
-;; MORAL-II: Redefining somebody else's advice is BAAAAD (to speak with
-;; George Walker Bush), and why would you redefine your own advice anyway?
-;; Advice is a mechanism to facilitate function redefinition, not advice
-;; redefinition (wait until I write Meta-Advice :-). If you really have
-;; to undo somebody else's advice try to write a "neutralizing" advice.
-
-;; @@ Advising macros and special forms and other dangerous things:
-;; ================================================================
-;; Look at the corresponding tutorial sections for more information on
-;; these topics. Here it suffices to point out that the special treatment
-;; of macros and special forms by the byte-compiler can lead to problems
-;; when they get advised. Macros can create problems because they get
-;; expanded at compile time, hence, they might not have all the necessary
-;; runtime support and such advice cannot be de/activated or changed as
-;; it is possible for functions. Special forms create problems because they
-;; have to be advised "into" macros, i.e., an advised special form is a
-;; implemented as a macro, hence, in most cases the byte-compiler will
-;; not recognize it as a special form anymore which can lead to very strange
-;; results.
-;;
-;; MORAL: - Only advise macros or special forms when you are absolutely sure
-;;          what you are doing.
-;;        - As a safety measure, always do `ad-deactivate-all' before you
-;;          byte-compile a file to make sure that even if some inconsiderate
-;;          person advised some special forms you'll get proper compilation
-;;          results. After compilation do `ad-activate-all' to get back to
-;;          the previous state.
-
-;; @@ Adding a piece of advice with `ad-add-advice':
-;; =================================================
-;; The non-interactive function `ad-add-advice' can be used to add a piece of
-;; advice to some function without using `defadvice'. This is useful if advice
-;; has to be added somewhere by a function (also look at `ad-make-advice').
-
-;; @@ Activation/deactivation advices, file load hooks:
-;; ====================================================
-;; There are two special classes of advice called `activation' and
-;; `deactivation'. The body forms of these advices are not included into the
-;; advised definition of a function, rather they are assembled into a hook
-;; form which will be evaluated whenever the advice-info of the advised
-;; function gets activated or deactivated. One application of this mechanism
-;; is to define file load hooks for files that do not provide such hooks
-;; (v19s already come with a general file-load-hook mechanism, v18s don't).
-;; For example, suppose you want to print a message whenever `file-x' gets
-;; loaded, and suppose the last function defined in `file-x' is
-;; `file-x-last-fn'.  Then we can define the following advice:
-;;
-;;   (defadvice file-x-last-fn (activation file-x-load-hook)
-;;      "Executed whenever file-x is loaded"
-;;      (if load-in-progress (message "Loaded file-x")))
-;;
-;; This will constitute a forward advice for function `file-x-last-fn' which
-;; will get activated when `file-x' is loaded (only if forward advice is
-;; enabled of course). Because there are no "real" pieces of advice
-;; available for it, its definition will not be changed, but the activation
-;; advice will be run during its activation which is equivalent to having a
-;; file load hook for `file-x'.
-
-;; @@ Summary of main advice concepts:
-;; ===================================
-;; - Definition:
-;;     A piece of advice gets defined with `defadvice' and added to the
-;;     `advice-info' property of a function.
-;; - Enablement:
-;;     Every piece of advice has an enablement flag associated with it. Only
-;;     enabled advices are considered during construction of an advised
-;;     definition.
-;; - Activation:
-;;     Redefine an advised function with its advised definition. Constructs
-;;     an advised definition from scratch if no verifiable cached advised
-;;     definition is available and caches it.
-;; - Deactivation:
-;;     Back-define an advised function to its original definition.
-;; - Update:
-;;     Reactivate an advised function but only if its advice is currently 
-;;     active. This can be used to bring all currently advised function up
-;;     to date with the current state of advice without also activating
-;;     currently deactivated functions.
-;; - Caching:
-;;     Is the saving of an advised definition and an identifying cache-id so
-;;     it can be reused, for example, for activation after deactivation.
-;; - Preactivation:
-;;     Is the construction of an advised definition according to the current
-;;     state of advice during byte-compilation of a file with a preactivating
-;;     `defadvice'. That advised definition can then rather cheaply be used
-;;     during activation without having to construct an advised definition
-;;     from scratch at runtime.
-
-;; @@ Summary of interactive advice manipulation functions:
-;; ========================================================
-;; The following interactive functions can be used to manipulate the state
-;; of advised functions (all of them support completion on function names,
-;; advice classes and advice names):
-
-;; - ad-activate to activate the advice of a FUNCTION
-;; - ad-deactivate to deactivate the advice of a FUNCTION
-;; - ad-update   to activate the advice of a FUNCTION unless it was not
-;;               yet activated or is currently deactivated.
-;; - ad-unadvise deactivates a FUNCTION and removes all of its advice 
-;;               information, hence, it cannot be activated again
-;; - ad-recover  tries to redefine a FUNCTION to its original definition and
-;;               discards all advice information (a low-level `ad-unadvise').
-;;               Use only in emergencies.
-
-;; - ad-remove-advice removes a particular piece of advice of a FUNCTION.
-;;               You still have to do call `ad-activate' or `ad-update' to
-;;               activate the new state of advice.
-;; - ad-enable-advice enables a particular piece of advice of a FUNCTION.
-;; - ad-disable-advice disables a particular piece of advice of a FUNCTION.
-;; - ad-enable-regexp maps over all currently advised functions and enables
-;;               every advice whose name contains a match for a regular
-;;               expression.
-;; - ad-disable-regexp disables matching advices.
-
-;; - ad-activate-regexp   activates all advised function with a matching advice
-;; - ad-deactivate-regexp deactivates all advised function with matching advice
-;; - ad-update-regexp     updates all advised function with a matching advice
-;; - ad-activate-all      activates all advised functions
-;; - ad-deactivate-all    deactivates all advised functions
-;; - ad-update-all        updates all advised functions
-;; - ad-unadvise-all      unadvises all advised functions
-;; - ad-recover-all       recovers all advised functions
-
-;; - ad-compile byte-compiles a function/macro if it is compilable.
-
-;; @@ Summary of forms with special meanings when used within an advice:
-;; =====================================================================
-;;   ad-return-value   name of the return value variable (get/settable)
-;;   ad-subr-args      name of &rest argument variable used for advised
-;;                     subrs whose actual argument list cannot be
-;;                     determined (get/settable)
-;;   (ad-get-arg <pos>), (ad-get-args <pos>),
-;;   (ad-set-arg <pos> <value>), (ad-set-args <pos> <value-list>)
-;;                     argument access text macros to get/set the values of
-;;                     actual arguments at a certain position
-;;   ad-arg-bindings   text macro that returns the actual names, values
-;;                     and types of the arguments as a list of bindings. The
-;;                     order of the bindings corresponds to the order of the
-;;                     arguments. The individual fields of every binding (name,
-;;                     value and type) can be accessed with the function
-;;                     `ad-arg-binding-field' (see example above).
-;;   ad-do-it          text macro that identifies the place where the original
-;;                     or wrapped definition should go in an around advice
-
-
-;; @ Foo games: An advice tutorial
-;; ===============================
-;; The following tutorial was created in Emacs 18.59. Left-justified
-;; s-expressions are input forms followed by one or more result forms.
-;; First we have to start the advice magic:
-;;
-;; (ad-start-advice)
-;; nil
-;;
-;; We start by defining an innocent looking function `foo' that simply
-;; adds 1 to its argument X:
-;;  
-;; (defun foo (x)
-;;   "Add 1 to X."
-;;   (1+ x))
-;; foo
-;;
-;; (foo 3)
-;; 4
-;;
-;; @@ Defining a simple piece of advice:
-;; =====================================
-;; Now let's define the first piece of advice for `foo'.  To do that we
-;; use the macro `defadvice' which takes a function name, a list of advice
-;; specifiers and a list of body forms as arguments.  The first element of
-;; the advice specifiers is the class of the advice, the second is its name,
-;; the third its position and the rest are some flags. The class of our
-;; first advice is `before', its name is `fg-add2', its position among the
-;; currently defined before advices (none so far) is `first', and the advice
-;; will be `activate'ed immediately. Advice names are global symbols, hence,
-;; the name space conventions used for function names should be applied. All
-;; advice names in this tutorial will be prefixed with `fg' for `Foo Games'
-;; (because everybody has the right to be inconsistent all the function names
-;; used in this tutorial do NOT follow this convention).
-;;
-;; In the body of an advice we can refer to the argument variables of the
-;; original function by name. Here we add 1 to X so the effect of calling
-;; `foo' will be to actually add 2. All of the advice definitions below only
-;; have one body form for simplicity, but there is no restriction to that
-;; extent. Every piece of advice can have a documentation string which will
-;; be combined with the documentation of the original function.
-;;
-;; (defadvice foo (before fg-add2 first activate)
-;;   "Add 2 to X."
-;;   (setq x (1+ x)))
-;; foo
-;;
-;; (foo 3)
-;; 5
-;;
-;; @@ Specifying the position of an advice:
-;; ========================================
-;; Now we define the second before advice which will cancel the effect of
-;; the previous advice. This time we specify the position as 0 which is
-;; equivalent to `first'. A number can be used to specify the zero-based
-;; position of an advice among the list of advices in the same class. This
-;; time we already have one before advice hence the position specification
-;; actually has an effect. So, after the following definition the position
-;; of the previous advice will be 1 even though we specified it with `first'
-;; above, the reason for this is that the position argument is relative to
-;; the currently defined pieces of advice which by now has changed.
-;;
-;; (defadvice foo (before fg-cancel-add2 0 activate)
-;;   "Again only add 1 to X."
-;;   (setq x (1- x)))
-;; foo
-;;
-;; (foo 3)
-;; 4
-;;
-;; @@ Redefining a piece of advice:
-;; ================================
-;; Now we define an advice with the same class and same name but with a
-;; different position. Defining an advice in a class in which an advice with
-;; that name already exists is interpreted as a redefinition of that
-;; particular advice, in which case the position argument will be ignored
-;; and the previous position of the redefined piece of advice is used.
-;; Advice flags can be specified with non-ambiguous initial substrings, hence,
-;; from now on we'll use `act' instead of the verbose `activate'.
-;;
-;; (defadvice foo (before fg-cancel-add2 last act)
-;;   "Again only add 1 to X."
-;;   (setq x (1- x)))
-;; foo
-;;
-;; @@ Assembly of advised documentation:
-;; =====================================
-;; The documentation strings of the various pieces of advice are assembled
-;; in order which shows that advice `fg-cancel-add2' is still the first
-;; `before' advice even though we specified position `last' above:
-;;
-;; (documentation 'foo)
-;; "Add 1 to X.
-;;
-;; This function is advised with the following advice(s):
-;;
-;; fg-cancel-add2 (before):
-;; Again only add 1 to X.
-;;
-;; fg-add2 (before):
-;; Add 2 to X."
-;;
-;; @@ Advising interactive behavior:
-;; =================================
-;; We can make a function interactive (or change its interactive behavior)
-;; by specifying an interactive form in one of the before or around
-;; advices (there could also be body forms in this advice). The particular
-;; definition always assigns 5 as an argument to X which gives us 6 as a
-;; result when we call foo interactively:
-;;
-;; (defadvice foo (before fg-inter last act)
-;;   "Use 5 as argument when called interactively."
-;;   (interactive (list 5)))
-;; foo
-;;
-;; (call-interactively 'foo)
-;; 6
-;;
-;; If more than one advice have an interactive declaration, then the one of
-;; the advice with the smallest position will be used (before advices go
-;; before around and after advices), hence, the declaration below does
-;; not have any effect:
-;;
-;; (defadvice foo (before fg-inter2 last act)
-;;   (interactive (list 6)))
-;; foo
-;;
-;; (call-interactively 'foo)
-;; 6
-;;
-;; Let's have a look at what the definition of `foo' looks like now 
-;; (indentation added by hand for legibility):
-;;
-;; (symbol-function 'foo)
-;; (lambda (x)
-;;   "$ad-doc: foo$"
-;;   (interactive (list 5))
-;;   (let (ad-return-value) 
-;;     (setq x (1- x)) 
-;;     (setq x (1+ x)) 
-;;     (setq ad-return-value (ad-Orig-foo x)) 
-;;     ad-return-value))
-;;
-;; @@ Around advices:
-;; ==================
-;; Now we'll try some `around' advices. An around advice is a wrapper around
-;; the original definition. It can shadow or establish bindings for the
-;; original definition, and it can look at and manipulate the value returned
-;; by the original function. The position of the special keyword `ad-do-it'
-;; specifies where the code of the original function will be executed. The
-;; keyword can appear multiple times which will result in multiple calls of
-;; the original function in the resulting advised code. Note, that if we don't
-;; specify a position argument (i.e., `first', `last' or a number), then 
-;; `first' (or 0) is the default):
-;;
-;; (defadvice foo (around fg-times-2 act)
-;;   "First double X."
-;;   (let ((x (* x 2)))
-;;     ad-do-it))
-;; foo
-;;
-;; (foo 3)
-;; 7
-;;
-;; Around advices are assembled like onion skins where the around advice
-;; with position 0 is the outermost skin and the advice at the last position
-;; is the innermost skin which is directly wrapped around the call of the
-;; original definition of the function. Hence, after the next `defadvice' we
-;; will first multiply X by 2 then add 1 and then call the original
-;; definition (i.e., add 1 again):
-;;
-;; (defadvice foo (around fg-add-1 last act)
-;;   "Add 1 to X."
-;;   (let ((x (1+ x)))
-;;     ad-do-it))
-;; foo
-;;
-;; (foo 3)
-;; 8
-;;
-;; Again, let's see what the definition of `foo' looks like so far:
-;;
-;; (symbol-function 'foo)
-;; (lambda (x) 
-;;   "$ad-doc: foo$"
-;;   (interactive (list 5)) 
-;;   (let (ad-return-value) 
-;;     (setq x (1- x)) 
-;;     (setq x (1+ x)) 
-;;     (let ((x (* x 2))) 
-;;       (let ((x (1+ x))) 
-;;         (setq ad-return-value (ad-Orig-foo x)))) 
-;;     ad-return-value))
-;;
-;; @@ Controlling advice activation:
-;; =================================
-;; In every `defadvice' so far we have used the flag `activate' to activate
-;; the advice immediately after its definition, and that's what we want in
-;; most cases. However, if we define multiple pieces of advice for a single
-;; function then activating every advice immediately is inefficient. A
-;; better way to do this is to only activate the last defined advice.
-;; For example:
-;;
-;; (defadvice foo (after fg-times-x)
-;;   "Multiply the result with X."
-;;   (setq ad-return-value (* ad-return-value x)))
-;; foo
-;;
-;; This still yields the same result as before:
-;; (foo 3)
-;; 8
-;;
-;; Now we define another advice and activate which will also activate the
-;; previous advice `fg-times-x'. Note the use of the special variable
-;; `ad-return-value' in the body of the advice which is set to the result of
-;; the original function. If we change its value then the value returned by
-;; the advised function will be changed accordingly:
-;;
-;; (defadvice foo (after fg-times-x-again act)
-;;   "Again multiply the result with X."
-;;   (setq ad-return-value (* ad-return-value x)))
-;; foo
-;;
-;; Now the advices have an effect:
-;;
-;; (foo 3)
-;; 72
-;;
-;; @@ Protecting advice execution:
-;; ===============================
-;; Once in a while we define an advice to perform some cleanup action, 
-;; for example:
-;;
-;; (defadvice foo (after fg-cleanup last act)
-;;   "Do some cleanup."
-;;   (print "Let's clean up now!"))
-;; foo
-;;
-;; However, in case of an error the cleanup won't be performed:
-;;
-;; (condition-case error
-;;     (foo t)
-;;   (error 'error-in-foo))
-;; error-in-foo
-;;
-;; To make sure a certain piece of advice gets executed even if some error or
-;; non-local exit occurred in any preceding code, we can protect it by using
-;; the `protect' keyword. (if any of the around advices is protected then the
-;; whole around advice onion will be protected):
-;;
-;; (defadvice foo (after fg-cleanup prot act)
-;;   "Do some protected cleanup."
-;;   (print "Let's clean up now!"))
-;; foo
-;;
-;; Now the cleanup form will be executed even in case of an error:
-;;
-;; (condition-case error
-;;     (foo t)
-;;   (error 'error-in-foo))
-;; "Let's clean up now!"
-;; error-in-foo
-;;
-;; Again, let's see what `foo' looks like:
-;;
-;; (symbol-function 'foo)
-;; (lambda (x) 
-;;   "$ad-doc: foo$"
-;;   (interactive (list 5)) 
-;;   (let (ad-return-value) 
-;;     (unwind-protect 
-;;         (progn (setq x (1- x)) 
-;;                (setq x (1+ x)) 
-;;                (let ((x (* x 2))) 
-;;                  (let ((x (1+ x))) 
-;;                    (setq ad-return-value (ad-Orig-foo x)))) 
-;;                (setq ad-return-value (* ad-return-value x)) 
-;;                (setq ad-return-value (* ad-return-value x))) 
-;;       (print "Let's clean up now!")) 
-;;     ad-return-value))
-;;
-;; @@ Compilation of advised definitions:
-;; ======================================
-;; Finally, we can specify the `compile' keyword in a `defadvice' to say
-;; that we want the resulting advised function to be byte-compiled
-;; (`compile' will be ignored unless we also specified `activate'):
-;;
-;; (defadvice foo (after fg-cleanup prot act comp)
-;;   "Do some protected cleanup."
-;;   (print "Let's clean up now!"))
-;; foo
-;;
-;; Now `foo' is byte-compiled:
-;;
-;; (symbol-function 'foo)
-;; (lambda (x) 
-;;   "$ad-doc: foo$"
-;;   (interactive (byte-code "....." [5] 1)) 
-;;   (byte-code "....." [ad-return-value x nil ((byte-code "....." [print "Let's clean up now!"] 2)) * 2 ad-Orig-foo] 6))
-;;
-;; (foo 3)
-;; "Let's clean up now!"
-;; 72
-;;
-;; @@ Enabling and disabling pieces of advice:
-;; ===========================================
-;; Once in a while it is desirable to temporarily disable a piece of advice
-;; so that it won't be considered during activation, for example, if two
-;; different packages advise the same function and one wants to temporarily
-;; neutralize the effect of the advice of one of the packages.
-;;
-;; The following disables the after advice `fg-times-x' in the function `foo'.
-;; All that does is to change a flag for this particular advice. All the
-;; other information defining it will be left unchanged (e.g., its relative
-;; position in this advice class, etc.).
-;;
-;; (ad-disable-advice 'foo 'after 'fg-times-x)
-;; nil
-;;
-;; For this to have an effect we have to activate `foo':
-;;
-;; (ad-activate 'foo)
-;; foo
-;;
-;; (foo 3)
-;; "Let's clean up now!"
-;; 24
-;;
-;; If we want to disable all multiplication advices in `foo' we can use a
-;; regular expression that matches the names of such advices. Actually, any
-;; advice name that contains a match for the regular expression will be
-;; called a match. A special advice class `any' can be used to consider
-;; all advice classes:
-;;
-;; (ad-disable-advice 'foo 'any "^fg-.*times")
-;; nil
-;;
-;; (ad-activate 'foo)
-;; foo
-;;
-;; (foo 3)
-;; "Let's clean up now!"
-;; 5
-;;
-;; To enable the disabled advice we could use either `ad-enable-advice'
-;; similar to `ad-disable-advice', or as an alternative `ad-enable-regexp'
-;; which will enable matching advices in ALL currently advised functions.
-;; Hence, this can be used to dis/enable advices made by a particular
-;; package to a set of functions as long as that package obeys standard
-;; advice name conventions.  We prefixed all advice names with `fg-', hence
-;; the following will do the trick (`ad-enable-regexp' returns the number
-;; of matched advices):
-;;
-;; (ad-enable-regexp "^fg-")
-;; 9
-;;
-;; The following will activate all currently active advised functions that
-;; contain some advice matched by the regular expression. This is a save
-;; way to update the activation of advised functions whose advice changed
-;; in some way or other without accidentally also activating currently
-;; deactivated functions:
-;;
-;; (ad-update-regexp "^fg-")
-;; nil
-;;
-;; (foo 3)
-;; "Let's clean up now!"
-;; 72
-;;
-;; Another use for the dis/enablement mechanism is to define a piece of advice
-;; and keep it "dormant" until a particular condition is satisfied, i.e., until
-;; then the advice will not be used during activation. The `disable' flag lets
-;; one do that with `defadvice':
-;;
-;; (defadvice foo (before fg-1-more dis)
-;;   "Add yet 1 more."
-;;   (setq x (1+ x)))
-;; foo
-;;
-;; (ad-activate 'foo)
-;; foo
-;;
-;; (foo 3)
-;; "Let's clean up now!"
-;; 72
-;;
-;; (ad-enable-advice 'foo 'before 'fg-1-more)
-;; nil
-;;
-;; (ad-activate 'foo)
-;; foo
-;;
-;; (foo 3)
-;; "Let's clean up now!"
-;; 160
-;;
-;; @@ Caching:
-;; ===========
-;; Advised definitions get cached to allow efficient activation/deactivation
-;; without having to reconstruct them if nothing in the advice-info of a
-;; function has changed. The following idiom can be used to temporarily
-;; deactivate functions that have a piece of advice defined by a certain
-;; package (we save the old definition to check out caching):
-;;
-;; (setq old-definition (symbol-function 'foo))
-;; (lambda (x) ....)
-;;
-;; (ad-deactivate-regexp "^fg-")
-;; nil
-;;
-;; (foo 3)
-;; 4
-;;
-;; (ad-activate-regexp "^fg-")
-;; nil
-;;
-;; (eq old-definition (symbol-function 'foo))
-;; t
-;;
-;; (foo 3)
-;; "Let's clean up now!"
-;; 160
-;;
-;; @@ Forward advice:
-;; ==================
-;; To enable automatic activation of forward advice we first have to set
-;; `ad-activate-on-definition' to t and restart advice:
-;;
-;; (setq ad-activate-on-definition t)
-;; t
-;;
-;; (ad-start-advice)
-;; (ad-activate-defined-function)
-;;
-;; Let's define a piece of advice for an undefined function:
-;;
-;; (defadvice bar (before fg-sub-1-more act)
-;;   "Subtract one more from X."
-;;   (setq x (1- x)))
-;; bar
-;;
-;; `bar' is not yet defined:
-;; (fboundp 'bar)
-;; nil
-;;
-;; Now we define it and the forward advice will get activated (only because
-;; `ad-activate-on-definition' was t when we started advice above with
-;; `ad-start-advice'):
-;;
-;; (defun bar (x)
-;;   "Subtract 1 from X."
-;;   (1- x))
-;; bar
-;;
-;; (bar 4)
-;; 2
-;;
-;; Redefinition will activate any available advice if the value of
-;; `ad-redefinition-action' is either `warn', `accept' or `discard':
-;;
-;; (defun bar (x)
-;;   "Subtract 2 from X."
-;;   (- x 2))
-;; bar
-;;
-;; (bar 4)
-;; 1
-;;
-;; @@ Preactivation:
-;; =================
-;; Constructing advised definitions is moderately expensive, hence, it is
-;; desirable to have a way to construct them at byte-compile time.
-;; Preactivation is a mechanism that allows one to do that.
-;;
-;; (defun fie (x)
-;;   "Multiply X by 2."
-;;   (* x 2))
-;; fie
-;;
-;; (defadvice fie (before fg-times-4 preact)
-;;   "Multiply X by 4."
-;;   (setq x (* x 2)))
-;; fie
-;;
-;; This advice did not affect `fie'...
-;;
-;; (fie 2)
-;; 4
-;;
-;; ...but it constructed a cached definition that will be used once `fie' gets
-;; activated as long as its current advice state is the same as it was during
-;; preactivation:
-;;
-;; (setq cached-definition (ad-get-cache-definition 'fie))
-;; (lambda (x) ....)
-;;
-;; (ad-activate 'fie)
-;; fie
-;;
-;; (eq cached-definition (symbol-function 'fie))
-;; t
-;;
-;; (fie 2)
-;; 8
-;;
-;; If you put a preactivating `defadvice' into a Lisp file that gets byte-
-;; compiled then the constructed advised definition will get compiled by
-;; the byte-compiler. For that to occur in a v18 emacs you have to put the
-;; `defadvice' inside a `defun' because the v18 compiler does not compile
-;; top-level forms other than `defun' or `defmacro', for example,
-;;
-;; (defun fg-defadvice-fum ()
-;;   (defadvice fum (before fg-times-4 preact act)
-;;     "Multiply X by 4."
-;;     (setq x (* x 2))))
-;; fg-defadvice-fum
-;;
-;; So far, no `defadvice' for `fum' got executed, but when we compile
-;; `fg-defadvice-fum' the `defadvice' will be expanded by the byte compiler.
-;; In order for preactivation to be effective we have to have a proper
-;; definition of `fum' around at preactivation time, hence, we define it now:
-;;
-;; (defun fum (x)
-;;   "Multiply X by 2."
-;;   (* x 2))
-;; fum
-;;
-;; Now we compile the defining function which will construct an advised
-;; definition during expansion of the `defadvice', compile it and store it
-;; as part of the compiled `fg-defadvice-fum':
-;;
-;; (ad-compile-function 'fg-defadvice-fum)
-;; (lambda nil (byte-code ...))
-;;
-;; `fum' is still completely unaffected:
-;;
-;; (fum 2)
-;; 4
-;;
-;; (ad-get-advice-info 'fum)
-;; nil
-;;
-;; (fg-defadvice-fum)
-;; fum
-;;
-;; Now the advised version of `fum' is compiled because the compiled definition
-;; constructed during preactivation was used, even though we did not specify
-;; the `compile' flag:
-;;
-;; (symbol-function 'fum)
-;; (lambda (x) 
-;;   "$ad-doc: fum$"
-;;   (byte-code "....." [ad-return-value x nil * 2 ad-Orig-fum] 4))
-;;
-;; (fum 2)
-;; 8
-;;
-;; A preactivated definition will only be used if it matches the current
-;; function definition and advice information. If it does not match it
-;; will simply be discarded and a new advised definition will be constructed
-;; from scratch. For example, let's first remove all advice-info for `fum':
-;;
-;; (ad-unadvise 'fum)
-;; (("fie") ("bar") ("foo") ...)
-;;
-;; And now define a new piece of advice:
-;;
-;; (defadvice fum (before fg-interactive act)
-;;   "Make fum interactive."
-;;   (interactive "nEnter x: "))
-;; fum
-;;
-;; When we now try to use a preactivation it will not be used because the
-;; current advice state is different from the one at preactivation time. This
-;; is no tragedy, everything will work as expected just not as efficient,
-;; because a new advised definition has to be constructed from scratch:
-;;
-;; (fg-defadvice-fum)
-;; fum
-;;
-;; A new uncompiled advised definition got constructed:
-;;
-;; (ad-compiled-p (symbol-function 'fum))
-;; nil
-;;
-;; (fum 2)
-;; 8
-;;
-;; MORAL: To get all the efficiency out of preactivation the function
-;; definition and advice state at preactivation time must be the same as the
-;; state at activation time. Preactivation does work with forward advice, all
-;; that's necessary is that the definition of the forward advised function is
-;; available when the `defadvice' with the preactivation gets compiled.
-;;
-;; @@ Portable argument access:
-;; ============================
-;; So far, we always used the actual argument variable names to access an
-;; argument in a piece of advice. For many advice applications this is
-;; perfectly ok and keeps advices simple. However, it decreases portability
-;; of advices because it assumes specific argument variable names. For example,
-;; if one advises a subr such as `eval-region' which then gets redefined by
-;; some package (e.g., edebug) into a function with different argument names,
-;; then a piece of advice written for `eval-region' that was written with
-;; the subr arguments in mind will break. Similar situations arise when one
-;; switches between major Emacs versions, e.g., certain subrs in v18 are
-;; functions in v19 and vice versa. Also, in v19s subr argument lists
-;; are available and will be used, while they are not available in v18.
-;;
-;; Argument access text macros allow one to access arguments of an advised
-;; function in a portable way without having to worry about all these
-;; possibilities. These macros will be translated into the proper access forms
-;; at activation time, hence, argument access will be as efficient as if
-;; the arguments had been used directly in the definition of the advice.
-;;
-;; (defun fuu (x y z)
-;;   "Add 3 numbers."
-;;   (+ x y z))
-;; fuu
-;;
-;; (fuu 1 1 1)
-;; 3
-;;
-;; Argument access macros specify actual arguments at a certain position.
-;; Position 0 access the first actual argument, position 1 the second etc.
-;; For example, the following advice adds 1 to each of the 3 arguments:
-;;
-;; (defadvice fuu (before fg-add-1-to-all act)
-;;   "Adds 1 to all arguments."
-;;   (ad-set-arg 0 (1+ (ad-get-arg 0)))
-;;   (ad-set-arg 1 (1+ (ad-get-arg 1)))
-;;   (ad-set-arg 2 (1+ (ad-get-arg 2))))
-;; fuu
-;;
-;; (fuu 1 1 1)
-;; 6
-;;
-;; Now suppose somebody redefines `fuu' with a rest argument. Our advice
-;; will still work because we used access macros (note, that automatic
-;; advice activation is still in effect, hence, the redefinition of `fuu'
-;; will automatically activate all its advice):
-;;
-;; (defun fuu (&rest numbers)
-;;   "Add NUMBERS."
-;;   (apply '+ numbers))
-;; fuu
-;;
-;; (fuu 1 1 1)
-;; 6
-;;
-;; (fuu 1 1 1 1 1 1)
-;; 9
-;;
-;; What's important to notice is that argument access macros access actual
-;; arguments regardless of how they got distributed onto argument variables.
-;; In Emacs Lisp the semantics of an actual argument is determined purely
-;; by position, hence, as long as nobody changes the semantics of what a
-;; certain actual argument at a certain position means the access macros
-;; will do the right thing.
-;;
-;; Because of &rest arguments we need a second kind of access macro that
-;; can access all actual arguments starting from a certain position:
-;;
-;; (defadvice fuu (before fg-print-args act)
-;;   "Print all arguments."
-;;   (print (ad-get-args 0)))
-;; fuu
-;;
-;; (fuu 1 2 3 4 5)
-;; (1 2 3 4 5)
-;; 18
-;;
-;; (defadvice fuu (before fg-set-args act)
-;;   "Swaps 2nd and 3rd arg and discards all the rest."
-;;   (ad-set-args 1 (list (ad-get-arg 2) (ad-get-arg 1))))
-;; fuu
-;;
-;; (fuu 1 2 3 4 4 4 4 4 4)
-;; (1 3 2)
-;; 9
-;;
-;; (defun fuu (x y z)
-;;   "Add 3 numbers."
-;;   (+ x y z))
-;;
-;; (fuu 1 2 3)
-;; (1 3 2)
-;; 9
-;;
-;; @@ Defining the argument list of an advised function:
-;; =====================================================
-;; Once in a while it might be desirable to advise a function and additionally
-;; give it an extra argument that controls the advised code, for example, one
-;; might want to make an interactive function sensitive to a prefix argument.
-;; For such cases `defadvice' allows the specification of an argument list
-;; for the advised function. Similar to the redefinition of interactive 
-;; behavior, the first argument list specification found in the list of before/
-;; around/after advices will be used. Of course, the specified argument list
-;; should be downward compatible with the original argument list, otherwise
-;; functions that call the advised function with the original argument list
-;; in mind will break.
-;;
-;; (defun fii (x)
-;;   "Add 1 to X."
-;;   (1+ x))
-;; fii
-;;
-;; Now we advise `fii' to use an optional second argument that controls the
-;; amount of incrementation. A list following the (optional) position
-;; argument of the advice will be interpreted as an argument list
-;; specification. This means you cannot specify an empty argument list, and
-;; why would you want to anyway?
-;;
-;; (defadvice fii (before fg-inc-x (x &optional incr) act)
-;;   "Increment X by INCR (default is 1)."
-;;   (setq x (+ x (1- (or incr 1)))))
-;; fii
-;;
-;; (fii 3)
-;; 4
-;;
-;; (fii 3 2)
-;; 5
-;;
-;; @@ Specifying argument lists of subrs:
-;; ======================================
-;; The argument lists of subrs cannot be determined directly from Lisp.
-;; This means that Advice has to use `(&rest ad-subr-args)' as the
-;; argument list of the advised subr which is not very efficient. In Lemacs
-;; subr argument lists can be determined from their documentation string, in
-;; Emacs-19 this is the case for some but not all subrs. To accommodate
-;; for the cases where the argument lists cannot be determined (e.g., in a
-;; v18 Emacs) Advice comes with a specification mechanism that allows the
-;; advice programmer to tell advice what the argument list of a certain subr
-;; really is.
-;;
-;; In a v18 Emacs the following will return the &rest idiom:
-;;
-;; (ad-arglist (symbol-function 'car))
-;; (&rest ad-subr-args)
-;;
-;; To tell advice what the argument list of `car' really is we
-;; can do the following:
-;;
-;; (ad-define-subr-args 'car '(list))
-;; ((list))
-;;
-;; Now `ad-arglist' will return the proper argument list (this method is
-;; actually used by advice itself for the advised definition of `fset'):
-;;
-;; (ad-arglist (symbol-function 'car))
-;; (list)
-;;
-;; The defined argument list will be stored on the property list of the
-;; subr name symbol. When advice looks for a subr argument list it first
-;; checks for a definition on the property list, if that fails it tries
-;; to infer it from the documentation string and caches it on the property
-;; list if it was successful, otherwise `(&rest ad-subr-args)' will be used.
-;;
-;; @@ Advising interactive subrs:
-;; ==============================
-;; For the most part there is no difference between advising functions and
-;; advising subrs. There is one situation though where one might have to write
-;; slightly different advice code for subrs than for functions. This case
-;; arises when one wants to access subr arguments in a before/around advice
-;; when the arguments were determined by an interactive call to the subr.
-;; Advice cannot determine what `interactive' form determines the interactive
-;; behavior of the subr, hence, when it calls the original definition in an
-;; interactive subr invocation it has to use `call-interactively' to generate
-;; the proper interactive behavior. Thus up to that call the arguments of the
-;; interactive subr will be nil. For example, the following advice for
-;; `kill-buffer' will not work in an interactive invocation...
-;;
-;; (defadvice kill-buffer (before fg-kill-buffer-hook first act preact comp)
-;;   (my-before-kill-buffer-hook (ad-get-arg 0)))
-;; kill-buffer
-;;
-;; ...because the buffer argument will be nil in that case. The way out of
-;; this dilemma is to provide an `interactive' specification that mirrors
-;; the interactive behavior of the unadvised subr, for example, the following
-;; will do the right thing even when `kill-buffer' is called interactively:
-;;
-;; (defadvice kill-buffer (before fg-kill-buffer-hook first act preact comp)
-;;   (interactive "bKill buffer: ")
-;;   (my-before-kill-buffer-hook (ad-get-arg 0)))
-;; kill-buffer
-;;
-;; @@ Advising macros:
-;; ===================
-;; Advising macros is slightly different because there are two significant
-;; time points in the invocation of a macro: Expansion and evaluation time.
-;; For an advised macro instead of evaluating the original definition we
-;; use `macroexpand', that is, changing argument values and binding
-;; environments by pieces of advice has an affect during macro expansion
-;; but not necessarily during evaluation. In particular, any side effects
-;; of pieces of advice will occur during macro expansion.  To also affect
-;; the behavior during evaluation time one has to change the value of
-;; `ad-return-value' in a piece of after advice. For example:
-;;
-;; (defmacro foom (x)
-;;   (` (list (, x))))
-;; foom
-;;
-;; (foom '(a))
-;; ((a))
-;;
-;; (defadvice foom (before fg-print-x act)
-;;   "Print the value of X."
-;;   (print x))
-;; foom
-;;
-;; The following works as expected because evaluation immediately follows
-;; macro expansion:
-;;
-;; (foom '(a))
-;; (quote (a))
-;; ((a))
-;;
-;; However, the printing happens during expansion (or byte-compile) time:
-;;
-;; (macroexpand '(foom '(a)))
-;; (quote (a))
-;; (list (quote (a)))
-;;
-;; If we want it to happen during evaluation time we have to do the 
-;; following (first remove the old advice):
-;;
-;; (ad-remove-advice 'foom 'before 'fg-print-x)
-;; nil
-;;
-;; (defadvice foom (after fg-print-x act)
-;;   "Print the value of X."
-;;   (setq ad-return-value
-;;         (` (progn (print (, x))
-;;                   (, ad-return-value)))))
-;; foom
-;;
-;; (macroexpand '(foom '(a)))
-;; (progn (print (quote (a))) (list (quote (a))))
-;;
-;; (foom '(a))
-;; (a)
-;; ((a))
-;;
-;; While this method might seem somewhat cumbersome, it is very general
-;; because it allows one to influence macro expansion as well as evaluation.
-;; In general, advising macros should be a rather rare activity anyway, in
-;; particular, because compile-time macro expansion takes away a lot of the
-;; flexibility and effectiveness of the advice mechanism. Macros that were
-;; compile-time expanded before the advice was activated will of course never
-;; exhibit the advised behavior.
-;;
-;; @@ Advising special forms:
-;; ==========================
-;; Now for something that should be even more rare than advising macros:
-;; Advising special forms. Because special forms are irregular in their
-;; argument evaluation behavior (e.g., `setq' evaluates the second but not
-;; the first argument) they have to be advised into macros. A dangerous
-;; consequence of this is that the byte-compiler will not recognize them
-;; as special forms anymore (well, in most cases) and use their expansion
-;; rather than the proper byte-code. Also, because the original definition
-;; of a special form cannot be `funcall'ed, `eval' has to be used instead
-;; which is less efficient.
-;;
-;; MORAL: Do not advise special forms unless you are completely sure about
-;;        what you are doing (some of the forward advice behavior is
-;;        implemented via advice of the special forms `defun' and `defmacro').
-;;        As a safety measure one should always do `ad-deactivate-all' before
-;;        one byte-compiles a file to avoid any interference of advised
-;;        special forms.
-;;
-;; Apart from the safety concerns advising special forms is not any different
-;; from advising plain functions or subrs.
-
-
-;;; Code:
-
-;; @ Advice implementation:
-;; ========================
-
-;; @@ Compilation idiosyncrasies:
-;; ==============================
-
-;; `defadvice' expansion needs quite a few advice functions and variables,
-;; hence, I need to preload the file before it can be compiled.  To avoid
-;; interference of bogus compiled files I always preload the source file:
-(provide 'advice-preload)
-;; During a normal load this is a noop:
-(require 'advice-preload "advice.el")
-
-
-(defmacro ad-lemacs-p ()
-  ;;Expands into Non-nil constant if we run Lucid's version of Emacs-19.
-  ;;Unselected conditional code will be optimized away during compilation.
-  (string-match "Lucid" emacs-version))
-
-
-;; @@ Variable definitions:
-;; ========================
-
-(defconst ad-version "2.14")
-
-;;;###autoload
-(defvar ad-redefinition-action 'warn
-  "*Defines what to do with redefinitions during Advice de/activation.
-Redefinition occurs if a previously activated function that already has an
-original definition associated with it gets redefined and then de/activated.
-In such a case we can either accept the current definition as the new
-original definition, discard the current definition and replace it with the
-old original, or keep it and raise an error.  The values `accept', `discard',
-`error' or `warn' govern what will be done.  `warn' is just like `accept' but
-it additionally prints a warning message.  All other values will be
-interpreted as `error'.")
-
-;;;###autoload
-(defvar ad-default-compilation-action 'maybe
-  "*Defines whether to compile advised definitions during activation.
-A value of `always' will result in unconditional compilation, `never' will
-always avoid compilation, `maybe' will compile if the byte-compiler is already
-loaded, and `like-original' will compile if the original definition of the
-advised function is compiled or a built-in function. Every other value will
-be interpreted as `maybe'. This variable will only be considered if the 
-COMPILE argument of `ad-activate' was supplied as nil.")
-
-
-;; @@ Some utilities:
-;; ==================
-
-;; We don't want the local arguments to interfere with anything
-;; referenced in the supplied functions => the cryptic casing:
-(defun ad-substitute-tree (sUbTrEe-TeSt fUnCtIoN tReE)
-  ;;"Substitutes qualifying subTREEs with result of FUNCTION(subTREE).
-  ;;Only proper subtrees are considered, for example, if TREE is (1 (2 (3)) 4)
-  ;;then the subtrees will be 1 (2 (3)) 2 (3) 3 4, dotted structures are
-  ;;allowed too.  Once a qualifying subtree has been found its subtrees will
-  ;;not be considered anymore.  (ad-substitute-tree 'atom 'identity tree)
-  ;;generates a copy of TREE."
-  (cond ((consp tReE)
-         (cons (if (funcall sUbTrEe-TeSt (car tReE))
-                   (funcall fUnCtIoN (car tReE))
-                 (if (consp (car tReE))
-                     (ad-substitute-tree sUbTrEe-TeSt fUnCtIoN (car tReE))
-                   (car tReE)))
-               (ad-substitute-tree sUbTrEe-TeSt fUnCtIoN (cdr tReE))))
-        ((funcall sUbTrEe-TeSt tReE)
-         (funcall fUnCtIoN tReE))
-        (t tReE)))
-
-;; this is just faster than `ad-substitute-tree':
-(defun ad-copy-tree (tree)
-  ;;"Returns a copy of the list structure of TREE."
-  (cond ((consp tree)
-	 (cons (ad-copy-tree (car tree))
-	       (ad-copy-tree (cdr tree))))
-	(t tree)))
-
-(defmacro ad-dolist (varform &rest body)
-  "A Common-Lisp-style dolist iterator with the following syntax:
-
-    (ad-dolist (VAR INIT-FORM [RESULT-FORM])
-       BODY-FORM...)
-
-which will iterate over the list yielded by INIT-FORM binding VAR to the
-current head at every iteration.  If RESULT-FORM is supplied its value will
-be returned at the end of the iteration, nil otherwise.  The iteration can be
-exited prematurely with `(ad-do-return [VALUE])'."
-  (let ((expansion
-         (` (let ((ad-dO-vAr (, (car (cdr varform))))
-		  (, (car varform)))
-	      (while ad-dO-vAr
-		(setq (, (car varform)) (car ad-dO-vAr))
-		(,@ body)
-		;;work around a backquote bug:
-		;;(` ((,@ '(foo)) (bar))) => (append '(foo) '(((bar)))) wrong
-		;;(` ((,@ '(foo)) (, '(bar)))) => (append '(foo) (list '(bar)))
-		(, '(setq ad-dO-vAr (cdr ad-dO-vAr))))
-	      (, (car (cdr (cdr varform))))))))
-    ;;ok, this wastes some cons cells but only during compilation:
-    (if (catch 'contains-return
-	  (ad-substitute-tree
-	   (function (lambda (subtree)
-		       (cond ((eq (car-safe subtree) 'ad-dolist))
-			     ((eq (car-safe subtree) 'ad-do-return)
-			      (throw 'contains-return t)))))
-	   'identity body)
-	  nil)
-	(` (catch 'ad-dO-eXiT (, expansion)))
-      expansion)))
-
-(defmacro ad-do-return (value)
-  (` (throw 'ad-dO-eXiT (, value))))
-
-(if (not (get 'ad-dolist 'lisp-indent-hook))
-    (put 'ad-dolist 'lisp-indent-hook 1))
-
-
-;; @@ Save real definitions of subrs used by Advice:
-;; =================================================
-;; Advice depends on the real, unmodified functionality of various subrs, 
-;; we save them here so advised versions will not interfere (eventually,
-;; we will save all subrs used in code generated by Advice):
-
-(defmacro ad-save-real-definition (function)
-  (let ((saved-function (intern (format "ad-real-%s" function))))
-    ;; Make sure the compiler is loaded during macro expansion:
-    (require 'byte-compile "bytecomp")
-    (` (if (not (fboundp '(, saved-function)))
-	   (progn (fset '(, saved-function) (symbol-function '(, function)))
-		  ;; Copy byte-compiler properties:
-		  (,@ (if (get function 'byte-compile)
-			  (` ((put '(, saved-function) 'byte-compile
-				   '(, (get function 'byte-compile)))))))
-		  (,@ (if (get function 'byte-opcode)
-			  (` ((put '(, saved-function) 'byte-opcode
-				   '(, (get function 'byte-opcode))))))))))))
-
-(defun ad-save-real-definitions ()
-  ;; Macro expansion will hardcode the values of the various byte-compiler
-  ;; properties into the compiled version of this function such that the
-  ;; proper values will be available at runtime without loading the compiler:
-  (ad-save-real-definition fset)
-  (ad-save-real-definition documentation))
-
-(ad-save-real-definitions)
-
-
-;; @@ Advice info access fns:
-;; ==========================
-
-;; Advice information for a particular function is stored on the
-;; advice-info property of the function symbol.  It is stored as an
-;; alist of the following format:
-;;
-;;      ((active . t/nil)
-;;       (before adv1 adv2 ...)
-;;       (around adv1 adv2 ...)
-;;       (after  adv1 adv2 ...)
-;;       (activation  adv1 adv2 ...)
-;;       (deactivation  adv1 adv2 ...)
-;;       (origname . <symbol fbound to origdef>)
-;;       (cache . (<advised-definition> . <id>)))
-
-;; List of currently advised though not necessarily activated functions
-;; (this list is maintained as a completion table):
-(defvar ad-advised-functions nil)
-
-(defmacro ad-pushnew-advised-function (function)
-  ;;"Add FUNCTION to `ad-advised-functions' unless its already there."
-  (` (if (not (assoc (symbol-name (, function)) ad-advised-functions))
-	 (setq ad-advised-functions
-	       (cons (list (symbol-name (, function)))
-		     ad-advised-functions)))))
-
-(defmacro ad-pop-advised-function (function)
-  ;;"Remove FUNCTION from `ad-advised-functions'."
-  (` (setq ad-advised-functions
-	   (delq (assoc (symbol-name (, function)) ad-advised-functions)
-		 ad-advised-functions))))
-
-(defmacro ad-do-advised-functions (varform &rest body)
-  ;;"`ad-dolist'-style iterator that maps over `ad-advised-functions'.
-  ;;     (ad-do-advised-functions (VAR [RESULT-FORM])
-  ;;         BODY-FORM...)
-  ;;Also see `ad-dolist'.  On each iteration VAR will be bound to the
-  ;;name of an advised function (a symbol)."
-  (` (ad-dolist ((, (car varform))
-		 ad-advised-functions
-		 (, (car (cdr varform))))
-       (setq (, (car varform)) (intern (car (, (car varform)))))
-       (,@ body))))
-
-(if (not (get 'ad-do-advised-functions 'lisp-indent-hook))
-    (put 'ad-do-advised-functions 'lisp-indent-hook 1))
-
-(defmacro ad-get-advice-info (function)
-  (` (get (, function) 'ad-advice-info)))
-
-(defmacro ad-set-advice-info (function advice-info)
-  (` (put (, function) 'ad-advice-info (, advice-info))))
-
-(defmacro ad-copy-advice-info (function)
-  (` (ad-copy-tree (get (, function) 'ad-advice-info))))
-
-(defmacro ad-is-advised (function)
-  ;;"Returns non-nil if FUNCTION has any advice info associated with it.
-  ;;This does not mean that the advice is also active."
-  (list 'ad-get-advice-info function))
-
-(defun ad-initialize-advice-info (function)
-  ;;"Initializes the advice info for FUNCTION.
-  ;;Assumes that FUNCTION has not yet been advised."
-  (ad-pushnew-advised-function function)
-  (ad-set-advice-info function (list (cons 'active nil))))
-
-(defmacro ad-get-advice-info-field (function field)
-  ;;"Retrieves the value of the advice info FIELD of FUNCTION."
-  (` (cdr (assq (, field) (ad-get-advice-info (, function))))))
-
-(defun ad-set-advice-info-field (function field value)
-  ;;"Destructively modifies VALUE of the advice info FIELD of FUNCTION."
-  (and (ad-is-advised function)
-       (cond ((assq field (ad-get-advice-info function))
-	      ;; A field with that name is already present:
-              (rplacd (assq field (ad-get-advice-info function)) value))
-	     (t;; otherwise, create a new field with that name:
-	      (nconc (ad-get-advice-info function)
-		     (list (cons field value)))))))
-
-;; Don't make this a macro so we can use it as a predicate:
-(defun ad-is-active (function)
-  ;;"non-nil if FUNCTION is advised and activated."
-  (ad-get-advice-info-field function 'active))
-
-
-;; @@ Access fns for single pieces of advice and related predicates:
-;; =================================================================
-
-(defun ad-make-advice (name protect enable definition)
-  "Constructs single piece of advice to be stored in some advice-info.
-NAME should be a non-nil symbol, PROTECT and ENABLE should each be
-either t or nil, and DEFINITION should be a list of the form
-`(advice lambda ARGLIST [DOCSTRING] [INTERACTIVE-FORM] BODY...)'."
-  (list name protect enable definition))
-
-;; ad-find-advice uses the alist structure directly ->
-;; change if this data structure changes!!
-(defmacro ad-advice-name (advice)
-  (list 'car advice))
-(defmacro ad-advice-protected (advice)
-  (list 'nth 1 advice))
-(defmacro ad-advice-enabled (advice)
-  (list 'nth 2 advice))
-(defmacro ad-advice-definition (advice)
-  (list 'nth 3 advice))
-
-(defun ad-advice-set-enabled (advice flag)
-  (rplaca (cdr (cdr advice)) flag))
-
-(defun ad-class-p (thing)
-  (memq thing ad-advice-classes))
-(defun ad-name-p (thing)
-  (and thing (symbolp thing)))
-(defun ad-position-p (thing)
-  (or (natnump thing)
-      (memq thing '(first last))))
-
-
-;; @@ Advice access functions:
-;; ===========================
-
-;; List of defined advice classes:
-(defvar ad-advice-classes '(before around after activation deactivation))
-
-(defun ad-has-enabled-advice (function class)
-  ;;"True if at least one of FUNCTION's advices in CLASS is enabled."
-  (ad-dolist (advice (ad-get-advice-info-field function class))
-    (if (ad-advice-enabled advice) (ad-do-return t))))
-
-(defun ad-has-redefining-advice (function)
-  ;;"True if FUNCTION's advice info defines at least 1 redefining advice.
-  ;;Redefining advices affect the construction of an advised definition."
-  (and (ad-is-advised function)
-       (or (ad-has-enabled-advice function 'before)
-	   (ad-has-enabled-advice function 'around)
-	   (ad-has-enabled-advice function 'after))))
-
-(defun ad-has-any-advice (function)
-  ;;"True if the advice info of FUNCTION defines at least one advice."
-  (and (ad-is-advised function)
-       (ad-dolist (class ad-advice-classes nil)
-	 (if (ad-get-advice-info-field function class)
-	     (ad-do-return t)))))
-
-(defun ad-get-enabled-advices (function class)
-  ;;"Returns the list of enabled advices of FUNCTION in CLASS."
-  (let (enabled-advices)
-    (ad-dolist (advice (ad-get-advice-info-field function class))
-      (if (ad-advice-enabled advice)
-	  (setq enabled-advices (cons advice enabled-advices))))
-    (reverse enabled-advices)))
-
-
-;; @@ Dealing with automatic advice activation via `fset/defalias':
-;; ================================================================
-
-;; Since Emacs 19.26 the built-in versions of `fset' and `defalias'
-;; take care of automatic advice activation, hence, we don't have to
-;; hack it anymore by advising `fset/defun/defmacro/byte-code/etc'.
-
-;; The functionality of the new `fset' is as follows:
-;;
-;;     fset(sym,newdef)
-;;       assign NEWDEF to SYM
-;;       if (get SYM 'ad-advice-info)
-;;          ad-activate(SYM, nil)
-;;       return (symbol-function SYM)
-;;
-;; Whether advised definitions created by automatic activations will be
-;; compiled depends on the value of `ad-default-compilation-action'.
-
-;; Since calling `ad-activate' in the built-in definition of `fset' can
-;; create major disasters we have to be a bit careful. One precaution is
-;; to provide a dummy definition for `ad-activate' which can be used to
-;; turn off automatic advice activation (e.g., when `ad-stop-advice' or
-;; `ad-recover-normality' are called). Another is to avoid recursive calls
-;; to `ad-activate-on' by using `ad-with-auto-activation-disabled' where
-;; appropriate, especially in a safe version of `fset'.
-
-;; For now define `ad-activate' to the dummy definition:
-(defun ad-activate (function &optional compile)
-  "Automatic advice activation is disabled. `ad-start-advice' enables it."
-  nil)
-
-;; This is just a copy of the above:
-(defun ad-activate-off (function &optional compile)
-  "Automatic advice activation is disabled. `ad-start-advice' enables it."
-  nil)
-
-;; This will be t for top-level calls to `ad-activate-on':
-(defvar ad-activate-on-top-level t)
-
-(defmacro ad-with-auto-activation-disabled (&rest body)
-  (` (let ((ad-activate-on-top-level nil))
-       (,@ body))))
-
-(defun ad-safe-fset (symbol definition)
-  ;; A safe `fset' which will never call `ad-activate' recursively.
-  (ad-with-auto-activation-disabled
-   (ad-real-fset symbol definition)))
-
-
-;; @@ Access functions for original definitions:
-;; ============================================
-;; The advice-info of an advised function contains its `origname' which is
-;; a symbol that is fbound to the original definition available at the first
-;; proper activation of the function after a legal re/definition.  If the
-;; original was defined via fcell indirection then `origname' will be defined
-;; just so.  Hence, to get hold of the actual original definition of a function
-;; we need to use `ad-real-orig-definition'.
-
-(defun ad-make-origname (function)
-  ;;"Makes name to be used to call the original FUNCTION."
-  (intern (format "ad-Orig-%s" function)))
-
-(defmacro ad-get-orig-definition (function)
-  (` (let ((origname (ad-get-advice-info-field (, function) 'origname)))
-       (if (fboundp origname)
-	   (symbol-function origname)))))
-
-(defmacro ad-set-orig-definition (function definition)
-  (` (ad-safe-fset
-      (ad-get-advice-info-field function 'origname) (, definition))))
-
-(defmacro ad-clear-orig-definition (function)
-  (` (fmakunbound (ad-get-advice-info-field (, function) 'origname))))
-
-
-;; @@ Interactive input functions:
-;; ===============================
-
-(defun ad-read-advised-function (&optional prompt predicate default)
-  ;;"Reads name of advised function with completion from the minibuffer.
-  ;;An optional PROMPT will be used to prompt for the function.  PREDICATE
-  ;;plays the same role as for `try-completion' (which see).  DEFAULT will
-  ;;be returned on empty input (defaults to the first advised function for
-  ;;which PREDICATE returns non-nil)."
-  (if (null ad-advised-functions)
-      (error "ad-read-advised-function: There are no advised functions"))
-  (setq default
-	(or default
-	    (ad-do-advised-functions (function)
-	      (if (or (null predicate)
-		      (funcall predicate function))
-		  (ad-do-return function)))
-	    (error "ad-read-advised-function: %s"
-		   "There are no qualifying advised functions")))
-  (let* ((ad-pReDiCaTe predicate)
-	 (function
-	  (completing-read
-	   (format "%s(default %s) " (or prompt "Function: ") default)
-	   ad-advised-functions
-	   (if predicate
-	       (function
-		(lambda (function)
-		  ;; Oops, no closures - the joys of dynamic scoping:
-		  ;; `predicate' clashed with the `predicate' argument
-		  ;; of Lemacs' `completing-read'.....
-		  (funcall ad-pReDiCaTe (intern (car function))))))
-	   t)))
-    (if (equal function "")
-	(if (ad-is-advised default)
-	    default
-	  (error "ad-read-advised-function: `%s' is not advised" default))
-      (intern function))))
-
-(defvar ad-advice-class-completion-table
-  (mapcar '(lambda (class) (list (symbol-name class)))
-	  ad-advice-classes))
-
-(defun ad-read-advice-class (function &optional prompt default)
-  ;;"Reads a legal advice class with completion from the minibuffer.
-  ;;An optional PROMPT will be used to prompt for the class.  DEFAULT will
-  ;;be returned on empty input (defaults to the first non-empty advice
-  ;;class of FUNCTION)."
-  (setq default
-	(or default
-	    (ad-dolist (class ad-advice-classes)
-	      (if (ad-get-advice-info-field function class)
-		  (ad-do-return class)))
-	    (error "ad-read-advice-class: `%s' has no advices" function)))
-  (let ((class (completing-read
-		(format "%s(default %s) " (or prompt "Class: ") default)
-		ad-advice-class-completion-table nil t)))
-    (if (equal class "")
-	default
-      (intern class))))
-
-(defun ad-read-advice-name (function class &optional prompt)
-  ;;"Reads name of existing advice of CLASS for FUNCTION with completion.
-  ;;An optional PROMPT is used to prompt for the name."
-  (let* ((name-completion-table
-          (mapcar (function (lambda (advice)
-			      (list (symbol-name (ad-advice-name advice)))))
-		  (ad-get-advice-info-field function class)))
-	 (default
-	   (if (null name-completion-table)
-	       (error "ad-read-advice-name: `%s' has no %s advice"
-		      function class)
-	     (car (car name-completion-table))))
-	 (prompt (format "%s(default %s) " (or prompt "Name: ") default))
-	 (name (completing-read prompt name-completion-table nil t)))
-    (if (equal name "")
-	(intern default)
-      (intern name))))
-
-(defun ad-read-advice-specification (&optional prompt)
-  ;;"Reads a complete function/class/name specification from minibuffer.
-  ;;The list of read symbols will be returned.  The optional PROMPT will
-  ;;be used to prompt for the function."
-  (let* ((function (ad-read-advised-function prompt))
-	 (class (ad-read-advice-class function))
-	 (name (ad-read-advice-name function class)))
-    (list function class name)))
-
-;; Use previous regexp as a default:
-(defvar ad-last-regexp "")
-
-(defun ad-read-regexp (&optional prompt)
-  ;;"Reads a regular expression from the minibuffer."
-  (let ((regexp (read-from-minibuffer
-		 (concat (or prompt "Regular expression: ")
-			 (if (equal ad-last-regexp "") ""
-			   (format "(default \"%s\") " ad-last-regexp))))))
-    (setq ad-last-regexp
-	  (if (equal regexp "") ad-last-regexp regexp))))
-
-
-;; @@ Finding, enabling, adding and removing pieces of advice:
-;; ===========================================================
-
-(defmacro ad-find-advice (function class name)
-  ;;"Finds the first advice of FUNCTION in CLASS with NAME."
-  (` (assq (, name) (ad-get-advice-info-field (, function) (, class)))))
-
-(defun ad-advice-position (function class name)
-  ;;"Returns position of first advice of FUNCTION in CLASS with NAME."
-  (let* ((found-advice (ad-find-advice function class name))
-	 (advices (ad-get-advice-info-field function class)))
-    (if found-advice
-	(- (length advices) (length (memq found-advice advices))))))
-
-(defun ad-find-some-advice (function class name)
-  "Finds the first of FUNCTION's advices in CLASS matching NAME.
-NAME can be a symbol or a regular expression matching part of an advice name.
-If CLASS is `any' all legal advice classes will be checked."
-  (if (ad-is-advised function)
-      (let (found-advice)
-	(ad-dolist (advice-class ad-advice-classes)
-	  (if (or (eq class 'any) (eq advice-class class))
-	      (setq found-advice
-		    (ad-dolist (advice (ad-get-advice-info-field
-					function advice-class))
-		      (if (or (and (stringp name)
-				   (string-match
-				    name (symbol-name
-					  (ad-advice-name advice))))
-			      (eq name (ad-advice-name advice)))
-			  (ad-do-return advice)))))
-	  (if found-advice (ad-do-return found-advice))))))
-
-(defun ad-enable-advice-internal (function class name flag)
-  ;;"Sets enable FLAG of FUNCTION's advices in CLASS matching NAME.
-  ;;If NAME is a string rather than a symbol then it's interpreted as a regular
-  ;;expression and all advices whose name contain a match for it will be 
-  ;;affected.  If CLASS is `any' advices in all legal advice classes will be 
-  ;;considered.  The number of changed advices will be returned (or nil if 
-  ;;FUNCTION was not advised)."
-  (if (ad-is-advised function)
-      (let ((matched-advices 0))
-	(ad-dolist (advice-class ad-advice-classes)
-	  (if (or (eq class 'any) (eq advice-class class))
-	      (ad-dolist (advice (ad-get-advice-info-field
-				  function advice-class))
-		(cond ((or (and (stringp name)
-				(string-match
-				 name (symbol-name (ad-advice-name advice))))
-			   (eq name (ad-advice-name advice)))
-		       (setq matched-advices (1+ matched-advices))
-		       (ad-advice-set-enabled advice flag))))))
-	matched-advices)))
-
-(defun ad-enable-advice (function class name)
-  "Enables the advice of FUNCTION with CLASS and NAME."
-  (interactive (ad-read-advice-specification "Enable advice of: "))
-  (if (ad-is-advised function)
-      (if (eq (ad-enable-advice-internal function class name t) 0)
-	  (error "ad-enable-advice: `%s' has no %s advice matching `%s'"
-		 function class name))
-    (error "ad-enable-advice: `%s' is not advised" function)))
-
-(defun ad-disable-advice (function class name)
-  "Disables the advice of FUNCTION with CLASS and NAME."
-  (interactive (ad-read-advice-specification "Disable advice of: "))
-  (if (ad-is-advised function)
-      (if (eq (ad-enable-advice-internal function class name nil) 0)
-	  (error "ad-disable-advice: `%s' has no %s advice matching `%s'"
-		 function class name))
-    (error "ad-disable-advice: `%s' is not advised" function)))
-
-(defun ad-enable-regexp-internal (regexp class flag)
-  ;;"Sets enable FLAGs of all CLASS advices whose name contains a REGEXP match.
-  ;;If CLASS is `any' all legal advice classes are considered.  The number of
-  ;;affected advices will be returned."
-  (let ((matched-advices 0))
-    (ad-do-advised-functions (advised-function)
-      (setq matched-advices
-	    (+ matched-advices
-	       (or (ad-enable-advice-internal
-		    advised-function class regexp flag)
-		   0))))
-    matched-advices))
-
-(defun ad-enable-regexp (regexp)
-  "Enables all advices with names that contain a match for REGEXP.
-All currently advised functions will be considered."
-  (interactive
-   (list (ad-read-regexp "Enable advices via regexp: ")))
-  (let ((matched-advices (ad-enable-regexp-internal regexp 'any t)))
-    (if (interactive-p)
-	(message "%d matching advices enabled" matched-advices))
-    matched-advices))
-
-(defun ad-disable-regexp (regexp)
-  "Disables all advices with names that contain a match for REGEXP.
-All currently advised functions will be considered."
-  (interactive
-   (list (ad-read-regexp "Disable advices via regexp: ")))
-  (let ((matched-advices (ad-enable-regexp-internal regexp 'any nil)))
-    (if (interactive-p)
-	(message "%d matching advices disabled" matched-advices))
-    matched-advices))
-
-(defun ad-remove-advice (function class name)
-  "Removes FUNCTION's advice with NAME from its advices in CLASS.
-If such an advice was found it will be removed from the list of advices
-in that CLASS."
-  (interactive (ad-read-advice-specification "Remove advice of: "))
-  (if (ad-is-advised function)
-      (let* ((advice-to-remove (ad-find-advice function class name)))
-	(if advice-to-remove
-	    (ad-set-advice-info-field
-	     function class
-	     (delq advice-to-remove (ad-get-advice-info-field function class)))
-	  (error "ad-remove-advice: `%s' has no %s advice `%s'"
-		 function class name)))
-    (error "ad-remove-advice: `%s' is not advised" function)))
-
-;;;###autoload
-(defun ad-add-advice (function advice class position)
-  "Adds a piece of ADVICE to FUNCTION's list of advices in CLASS.
-If FUNCTION already has one or more pieces of advice of the specified
-CLASS then POSITION determines where the new piece will go.  The value
-of POSITION can either be `first', `last' or a number where 0 corresponds
-to `first'.  Numbers outside the range will be mapped to the closest
-extreme position.  If there was already a piece of ADVICE with the same
-name, then the position argument will be ignored and the old advice
-will be overwritten with the new one.
-    If the FUNCTION was not advised already, then its advice info will be 
-initialized.  Redefining a piece of advice whose name is part of the cache-id
-will clear the cache."
-  (cond ((not (ad-is-advised function))
-         (ad-initialize-advice-info function)
-	 (ad-set-advice-info-field
-	  function 'origname (ad-make-origname function))))
-  (let* ((previous-position
-	  (ad-advice-position function class (ad-advice-name advice)))
-	 (advices (ad-get-advice-info-field function class))
-	 ;; Determine a numerical position for the new advice:
-	 (position (cond (previous-position)
-			 ((eq position 'first) 0)
-			 ((eq position 'last) (length advices))
-			 ((numberp position)
-			  (max 0 (min position (length advices))))
-			 (t 0))))
-    ;; Check whether we have to clear the cache:
-    (if (memq (ad-advice-name advice) (ad-get-cache-class-id function class))
-        (ad-clear-cache function))
-    (if previous-position
-	(setcar (nthcdr position advices) advice)
-      (if (= position 0)
-	  (ad-set-advice-info-field function class (cons advice advices))
-	(setcdr (nthcdr (1- position) advices)
-		(cons advice (nthcdr position advices)))))))
-
-
-;; @@ Accessing and manipulating function definitions:
-;; ===================================================
-
-(defmacro ad-macrofy (definition)
-  ;;"Takes a lambda function DEFINITION and makes a macro out of it."
-  (` (cons 'macro (, definition))))
-
-(defmacro ad-lambdafy (definition)
-  ;;"Takes a macro function DEFINITION and makes a lambda out of it."
-  (` (cdr (, definition))))
-
-;; There is no way to determine whether some subr is a special form or not,
-;; hence we need this list (which is probably out of date):
-(defvar ad-special-forms
-  (mapcar 'symbol-function
-	  '(and catch cond condition-case defconst defmacro
-			       defun defvar function if interactive let let*
-			       or prog1 prog2 progn quote save-excursion
-                               save-restriction save-window-excursion setq
-			       setq-default unwind-protect while
-			       with-output-to-temp-buffer)))
-
-(defmacro ad-special-form-p (definition)
-  ;;"non-nil if DEFINITION is a special form."
-  (list 'memq definition 'ad-special-forms))
-
-(defmacro ad-interactive-p (definition)
-  ;;"non-nil if DEFINITION can be called interactively."
-  (list 'commandp definition))
-
-(defmacro ad-subr-p (definition)
-  ;;"non-nil if DEFINITION is a subr."
-  (list 'subrp definition))
-
-(defmacro ad-macro-p (definition)
-  ;;"non-nil if DEFINITION is a macro."
-  (` (eq (car-safe (, definition)) 'macro)))
-
-(defmacro ad-lambda-p (definition)
-  ;;"non-nil if DEFINITION is a lambda expression."
-  (` (eq (car-safe (, definition)) 'lambda)))
-
-;; see ad-make-advice for the format of advice definitions:
-(defmacro ad-advice-p (definition)
-  ;;"non-nil if DEFINITION is a piece of advice."
-  (` (eq (car-safe (, definition)) 'advice)))
-
-;; Emacs/Lemacs cross-compatibility
-;; (compiled-function-p is an obsolete function in Emacs):
-(if (and (not (fboundp 'byte-code-function-p))
-	 (fboundp 'compiled-function-p))
-    (ad-safe-fset 'byte-code-function-p 'compiled-function-p))
-
-(defmacro ad-compiled-p (definition)
-  ;;"non-nil if DEFINITION is a compiled byte-code object."
-  (` (or (byte-code-function-p (, definition))
-	 (and (ad-macro-p (, definition))
-	      (byte-code-function-p (ad-lambdafy (, definition)))))))
-
-(defmacro ad-compiled-code (compiled-definition)
-  ;;"Returns the byte-code object of a COMPILED-DEFINITION."
-  (` (if (ad-macro-p (, compiled-definition))
-	 (ad-lambdafy (, compiled-definition))
-       (, compiled-definition))))
-
-(defun ad-lambda-expression (definition)
-  ;;"Returns the lambda expression of a function/macro/advice DEFINITION."
-  (cond ((ad-lambda-p definition)
-	 definition)
-	((ad-macro-p definition)
-	 (ad-lambdafy definition))
-	((ad-advice-p definition)
-	 (cdr definition))
-	(t nil)))
-
-(defun ad-arglist (definition &optional name)
-  ;;"Returns the argument list of DEFINITION.
-  ;;If DEFINITION could be from a subr then its NAME should be
-  ;;supplied to make subr arglist lookup more efficient."
-  (cond ((ad-compiled-p definition)
-	 (aref (ad-compiled-code definition) 0))
-	((consp definition)
-	 (car (cdr (ad-lambda-expression definition))))
-	((ad-subr-p definition)
-	 (if name
-	     (ad-subr-arglist name)
-	   ;; otherwise get it from its printed representation:
-	   (setq name (format "%s" definition))
-	   (string-match "^#<subr \\([^>]+\\)>$" name)
-	   (ad-subr-arglist
-	    (intern (substring name (match-beginning 1) (match-end 1))))))))
-
-;; Store subr-args as `((arg1 arg2 ...))' so I can distinguish
-;; a defined empty arglist `(nil)' from an undefined arglist:
-(defmacro ad-define-subr-args (subr arglist)
-  (` (put (, subr) 'ad-subr-arglist (list (, arglist)))))
-(defmacro ad-undefine-subr-args (subr)
-  (` (put (, subr) 'ad-subr-arglist nil)))
-(defmacro ad-subr-args-defined-p (subr)
-  (` (get (, subr) 'ad-subr-arglist)))
-(defmacro ad-get-subr-args (subr)
-  (` (car (get (, subr) 'ad-subr-arglist))))
-
-(defun ad-subr-arglist (subr-name)
-  ;;"Retrieve arglist of the subr with SUBR-NAME.
-  ;;Either use the one stored under the `ad-subr-arglist' property,
-  ;;or try to retrieve it from the docstring and cache it under
-  ;;that property, or otherwise use `(&rest ad-subr-args)'."
-  (cond ((ad-subr-args-defined-p subr-name)
-	 (ad-get-subr-args subr-name))
-	;; says jwz: Should use this for Lemacs 19.8 and above:
-	;;((fboundp 'subr-min-args)
-	;;  ...)
-	;; says hans: I guess what Jamie means is that I should use the values
-	;; of `subr-min-args' and `subr-max-args' to construct the subr arglist
-	;; without having to look it up via parsing the docstring, e.g.,
-	;; values 1 and 2 would suggest `(arg1 &optional arg2)' as an
-	;; argument list.  However, that won't work because there is no
-	;; way to distinguish a subr with args `(a &optional b &rest c)' from
-	;; one with args `(a &rest c)' using that mechanism. Also, the argument
-	;; names from the docstring are more meaningful. Hence, I'll stick with
-	;; the old way of doing things.
-	(t (let ((doc (or (ad-real-documentation subr-name t) "")))
-	     (cond ((string-match "^\\(([^\)]+)\\)\n?\\'" doc)
-		    (ad-define-subr-args
-		     subr-name
-		     (cdr (car (read-from-string
-				(downcase
-				 (substring doc
-					    (match-beginning 1)
-					    (match-end 1)))))))
-		    (ad-get-subr-args subr-name))
-		   ;; this is the old format used before Emacs 19.24:
-		   ((string-match
-		     "[\n\t ]*\narguments: ?\\((.*)\\)\n?\\'" doc)
-		    (ad-define-subr-args
-		     subr-name
-		     (car (read-from-string
-			   doc (match-beginning 1) (match-end 1))))
-		    (ad-get-subr-args subr-name))
-		   (t '(&rest ad-subr-args)))))))
-
-(defun ad-docstring (definition)
-  ;;"Returns the unexpanded docstring of DEFINITION."
-  (let ((docstring
-	 (if (ad-compiled-p definition)
-	     (ad-real-documentation definition t)
-	   (car (cdr (cdr (ad-lambda-expression definition)))))))
-    (if (or (stringp docstring)
-	    (natnump docstring))
-	docstring)))
-
-(defun ad-interactive-form (definition)
-  ;;"Returns the interactive form of DEFINITION."
-  (cond ((ad-compiled-p definition)
-	 (and (commandp definition)
-	      (list 'interactive (aref (ad-compiled-code definition) 5))))
-	((or (ad-advice-p definition)
-	     (ad-lambda-p definition))
-	 (commandp (ad-lambda-expression definition)))))
-
-(defun ad-body-forms (definition)
-  ;;"Returns the list of body forms of DEFINITION."
-  (cond ((ad-compiled-p definition)
-	 nil)
-	((consp definition)
-	 (nthcdr (+ (if (ad-docstring definition) 1 0)
-		    (if (ad-interactive-form definition) 1 0))
-		 (cdr (cdr (ad-lambda-expression definition)))))))
-
-;; Matches the docstring of an advised definition.
-;; The first group of the regexp matches the function name:
-(defvar ad-advised-definition-docstring-regexp "^\\$ad-doc: \\(.+\\)\\$$")
-
-(defun ad-make-advised-definition-docstring (function)
-  ;; Makes an identifying docstring for the advised definition of FUNCTION.
-  ;; Put function name into the documentation string so we can infer
-  ;; the name of the advised function from the docstring.  This is needed
-  ;; to generate a proper advised docstring even if we are just given a
-  ;; definition (also see the defadvice for `documentation'):
-  (format "$ad-doc: %s$" (prin1-to-string function)))
-
-(defun ad-advised-definition-p (definition)
-  ;;"non-nil if DEFINITION was generated from advice information."
-  (if (or (ad-lambda-p definition)
-	  (ad-macro-p definition)
-	  (ad-compiled-p definition))
-      (let ((docstring (ad-docstring definition)))
-	(and (stringp docstring)
-	     (string-match
-	      ad-advised-definition-docstring-regexp docstring)))))
-
-(defun ad-definition-type (definition)
-  ;;"Returns symbol that describes the type of DEFINITION."
-  (if (ad-macro-p definition)
-      'macro
-    (if (ad-subr-p definition)
-	(if (ad-special-form-p definition)
-	    'special-form
-	  'subr)
-      (if (or (ad-lambda-p definition)
-	      (ad-compiled-p definition))
-	  'function
-	(if (ad-advice-p definition)
-	    'advice)))))
-
-(defun ad-has-proper-definition (function)
-  ;;"True if FUNCTION is a symbol with a proper definition.
-  ;;For that it has to be fbound with a non-autoload definition."
-  (and (symbolp function)
-       (fboundp function)
-       (not (eq (car-safe (symbol-function function)) 'autoload))))
-
-;; The following two are necessary for the sake of packages such as
-;; ange-ftp which redefine functions via fcell indirection:
-(defun ad-real-definition (function)
-  ;;"Finds FUNCTION's definition at the end of function cell indirection."
-  (if (ad-has-proper-definition function)
-      (let ((definition (symbol-function function)))
-	(if (symbolp definition)
-	    (ad-real-definition definition)
-	  definition))))
-
-(defun ad-real-orig-definition (function)
-  ;;"Finds FUNCTION's real original definition starting from its `origname'."
-  (if (ad-is-advised function)
-      (ad-real-definition (ad-get-advice-info-field function 'origname))))
-
-(defun ad-is-compilable (function)
-  ;;"True if FUNCTION has an interpreted definition that can be compiled."
-  (and (ad-has-proper-definition function)
-       (or (ad-lambda-p (symbol-function function))
-	   (ad-macro-p (symbol-function function)))
-       (not (ad-compiled-p (symbol-function function)))))
-
-(defun ad-compile-function (function)
-  "Byte-compiles FUNCTION (or macro) if it is not yet compiled."
-  (interactive "aByte-compile function: ")
-  (if (ad-is-compilable function)
-      ;; Need to turn off auto-activation
-      ;; because `byte-compile' uses `fset':
-      (ad-with-auto-activation-disabled
-       (byte-compile function))))
-
-
-;; @@ Constructing advised definitions:
-;; ====================================
-;;
-;; Main design decisions about the form of advised definitions:
-;;
-;; A) How will original definitions be called?
-;; B) What will argument lists of advised functions look like?
-;;
-;; Ad A)
-;;    I chose to use function indirection for all four types of original
-;;    definitions (functions, macros, subrs and special forms), i.e., create
-;;    a unique symbol `ad-Orig-<name>' which is fbound to the original
-;;    definition and call it according to type and arguments.  Functions and
-;;    subrs that don't have any &rest arguments can be called directly in a
-;;    `(ad-Orig-<name> ....)' form.  If they have a &rest argument we have to
-;;    use `apply'.  Macros will be called with 
-;;    `(macroexpand '(ad-Orig-<name> ....))', and special forms also need a
-;;    form like that with `eval' instead of `macroexpand'.
-;;
-;; Ad B)
-;;    Use original arguments where possible and `(&rest ad-subr-args)'
-;;    otherwise, even though this seems to be more complicated and less
-;;    uniform than a general `(&rest args)' approach.  My reason to still
-;;    do it that way is that in most cases my approach leads to the more
-;;    efficient form for the advised function, and portability (e.g., to
-;;    make the same advice work regardless of whether something is a
-;;    function or a subr) can still be achieved with argument access macros.
-
-
-(defun ad-prognify (forms)
-  (cond ((<= (length forms) 1)
-	 (car forms))
-	(t (cons 'progn forms))))
-
-;; @@@ Accessing argument lists:
-;; =============================
-
-(defun ad-parse-arglist (arglist)
-  ;;"Parses ARGLIST into its required, optional and rest parameters.
-  ;;A three-element list is returned, where the 1st element is the list of
-  ;;required arguments, the 2nd is the list of optional arguments, and the 3rd
-  ;;is the name of an optional rest parameter (or nil)."
-  (let* (required optional rest)
-    (setq rest (car (cdr (memq '&rest arglist))))
-    (if rest (setq arglist (reverse (cdr (memq '&rest (reverse arglist))))))
-    (setq optional (cdr (memq '&optional arglist)))
-    (if optional
-	(setq required (reverse (cdr (memq '&optional (reverse arglist)))))
-      (setq required arglist))
-    (list required optional rest)))
-
-(defun ad-retrieve-args-form (arglist)
-  ;;"Generates a form which evaluates into names/values/types of ARGLIST.
-  ;;When the form gets evaluated within a function with that argument list
-  ;;it will result in a list with one entry for each argument, where the
-  ;;first element of each entry is the name of the argument, the second
-  ;;element is its actual current value, and the third element is either
-  ;;`required', `optional' or `rest' depending on the type of the argument."
-  (let* ((parsed-arglist (ad-parse-arglist arglist))
-	 (rest (nth 2 parsed-arglist)))
-    (` (list
-	(,@ (mapcar (function
-		     (lambda (req)
-		       (` (list '(, req) (, req) 'required))))
-		    (nth 0 parsed-arglist)))
-	(,@ (mapcar (function
-		     (lambda (opt)
-		       (` (list '(, opt) (, opt) 'optional))))
-		    (nth 1 parsed-arglist)))
-	(,@ (if rest (list (` (list '(, rest) (, rest) 'rest)))))
-	))))
-
-(defun ad-arg-binding-field (binding field)
-  (cond ((eq field 'name) (car binding))
-	((eq field 'value) (car (cdr binding)))
-	((eq field 'type) (car (cdr (cdr binding))))))
-
-(defun ad-list-access (position list)
-  (cond ((= position 0) list)
-	((= position 1) (list 'cdr list))
-	(t (list 'nthcdr position list))))
-
-(defun ad-element-access (position list)
-  (cond ((= position 0) (list 'car list))
-	((= position 1) (` (car (cdr (, list)))))
-	(t (list 'nth position list))))
-
-(defun ad-access-argument (arglist index)
-  ;;"Tells how to access ARGLIST's actual argument at position INDEX.
-  ;;For a required/optional arg it simply returns it, if a rest argument has
-  ;;to be accessed, it returns a list with the index and name."
-  (let* ((parsed-arglist (ad-parse-arglist arglist))
-	 (reqopt-args (append (nth 0 parsed-arglist)
-			      (nth 1 parsed-arglist)))
-	 (rest-arg (nth 2 parsed-arglist)))
-    (cond ((< index (length reqopt-args))
-	   (nth index reqopt-args))
-	  (rest-arg
-	   (list (- index (length reqopt-args)) rest-arg)))))
-
-(defun ad-get-argument (arglist index)
-  ;;"Returns form to access ARGLIST's actual argument at position INDEX."
-  (let ((argument-access (ad-access-argument arglist index)))
-    (cond ((consp argument-access)
-	   (ad-element-access
-	    (car argument-access) (car (cdr argument-access))))
-	  (argument-access))))
-
-(defun ad-set-argument (arglist index value-form)
-  ;;"Returns form to set ARGLIST's actual arg at INDEX to VALUE-FORM."
-  (let ((argument-access (ad-access-argument arglist index)))
-    (cond ((consp argument-access)
-	   ;; should this check whether there actually is something to set?
-	   (` (setcar (, (ad-list-access
-			  (car argument-access) (car (cdr argument-access))))
-		      (, value-form))))
-	  (argument-access
-	   (` (setq (, argument-access) (, value-form))))
-	  (t (error "ad-set-argument: No argument at position %d of `%s'"
-		    index arglist)))))
-
-(defun ad-get-arguments (arglist index)
-  ;;"Returns form to access all actual arguments starting at position INDEX."
-  (let* ((parsed-arglist (ad-parse-arglist arglist))
-	 (reqopt-args (append (nth 0 parsed-arglist)
-			      (nth 1 parsed-arglist)))
-	 (rest-arg (nth 2 parsed-arglist))
-	 args-form)
-    (if (< index (length reqopt-args))
-	(setq args-form (` (list (,@ (nthcdr index reqopt-args))))))
-    (if rest-arg
-	(if args-form
-	    (setq args-form (` (nconc (, args-form) (, rest-arg))))
-	  (setq args-form (ad-list-access (- index (length reqopt-args))
-					  rest-arg))))
-    args-form))
-
-(defun ad-set-arguments (arglist index values-form)
-  ;;"Makes form to assign elements of VALUES-FORM as actual ARGLIST args.
-  ;;The assignment starts at position INDEX."
-  (let ((values-index 0)
-	argument-access set-forms)
-    (while (setq argument-access (ad-access-argument arglist index))
-      (if (symbolp argument-access)
-	  (setq set-forms
-		(cons (ad-set-argument
-		       arglist index
-		       (ad-element-access values-index 'ad-vAlUeS))
-		      set-forms))
-	(setq set-forms
-	      (cons (if (= (car argument-access) 0)
-			(list 'setq
-			      (car (cdr argument-access))
-			      (ad-list-access values-index 'ad-vAlUeS))
-		      (list 'setcdr
-			    (ad-list-access (1- (car argument-access))
-					    (car (cdr argument-access)))
-			    (ad-list-access values-index 'ad-vAlUeS)))
-		    set-forms))
-	;; terminate loop
-	(setq arglist nil))
-      (setq index (1+ index))
-      (setq values-index (1+ values-index)))
-    (if (null set-forms)
-	(error "ad-set-arguments: No argument at position %d of `%s'"
-	       index arglist)
-      (if (= (length set-forms) 1)
-	  ;; For exactly one set-form we can use values-form directly,...
-	  (ad-substitute-tree
-	   (function (lambda (form) (eq form 'ad-vAlUeS)))
-	   (function (lambda (form) values-form))
-	   (car set-forms))
-	;; ...if we have more we have to bind it to a variable:
-	(` (let ((ad-vAlUeS (, values-form)))
-	     (,@ (reverse set-forms))
-	     ;; work around the old backquote bug:
-	     (, 'ad-vAlUeS)))))))
-
-(defun ad-insert-argument-access-forms (definition arglist)
-  ;;"Expands arg-access text macros in DEFINITION according to ARGLIST."
-  (ad-substitute-tree
-   (function
-    (lambda (form)
-      (or (eq form 'ad-arg-bindings)
-	  (and (memq (car-safe form)
-		     '(ad-get-arg ad-get-args ad-set-arg ad-set-args))
-	       (integerp (car-safe (cdr form)))))))
-   (function
-    (lambda (form)
-      (if (eq form 'ad-arg-bindings)
-	  (ad-retrieve-args-form arglist)
-	(let ((accessor (car form))
-	      (index (car (cdr form)))
-	      (val (car (cdr (ad-insert-argument-access-forms
-			      (cdr form) arglist)))))
-	  (cond ((eq accessor 'ad-get-arg)
-		 (ad-get-argument arglist index))
-		((eq accessor 'ad-set-arg)
-		 (ad-set-argument arglist index val))
-		((eq accessor 'ad-get-args)
-		 (ad-get-arguments arglist index))
-		((eq accessor 'ad-set-args)
-		 (ad-set-arguments arglist index val)))))))
-		   definition))
-
-;; @@@ Mapping argument lists:
-;; ===========================
-;; Here is the problem:
-;; Suppose function foo was called with (foo 1 2 3 4 5), and foo has the
-;; argument list (x y &rest z), and we want to call the function bar which
-;; has argument list (a &rest b) with a combination of x, y and z so that
-;; the effect is just as if we had called (bar 1 2 3 4 5) directly. 
-;; The mapping should work for any two argument lists.
-
-(defun ad-map-arglists (source-arglist target-arglist)
-  "Makes `funcall/apply' form to map SOURCE-ARGLIST to TARGET-ARGLIST.
-The arguments supplied to TARGET-ARGLIST will be taken from SOURCE-ARGLIST just
-as if they had been supplied to a function with TARGET-ARGLIST directly. 
-Excess source arguments will be neglected, missing source arguments will be 
-supplied as nil.  Returns a `funcall' or `apply' form with the second element
-being `function' which has to be replaced by an actual function argument.
-Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return
-         `(funcall function a (car args) (car (cdr args)) (nth 2 args))'."
-  (let* ((parsed-source-arglist (ad-parse-arglist source-arglist))
-	 (source-reqopt-args (append (nth 0 parsed-source-arglist)
-				     (nth 1 parsed-source-arglist)))
-	 (source-rest-arg (nth 2 parsed-source-arglist))
-	 (parsed-target-arglist (ad-parse-arglist target-arglist))
-	 (target-reqopt-args (append (nth 0 parsed-target-arglist)
-				     (nth 1 parsed-target-arglist)))
-	 (target-rest-arg (nth 2 parsed-target-arglist))
-	 (need-apply (and source-rest-arg target-rest-arg))
-	 (target-arg-index -1))
-    ;; This produces ``error-proof'' target function calls with the exception
-    ;; of a case like (&rest a) mapped onto (x &rest y) where the actual args
-    ;; supplied to A might not be enough to supply the required target arg X
-    (append (list (if need-apply 'apply 'funcall) 'function)
-	    (cond (need-apply
-		   ;; `apply' can take care of that directly:
-		   (append source-reqopt-args (list source-rest-arg)))
-		  (t (mapcar (function
-			      (lambda (arg)
-				(setq target-arg-index (1+ target-arg-index))
-				(ad-get-argument
-				 source-arglist target-arg-index)))
-			     (append target-reqopt-args
-				     (and target-rest-arg
-					  ;; If we have a rest arg gobble up
-					  ;; remaining source args:
-					  (nthcdr (length target-reqopt-args)
-						  source-reqopt-args)))))))))
-
-(defun ad-make-mapped-call (source-arglist target-arglist target-function)
-  ;;"Makes form to call TARGET-FUNCTION with args from SOURCE-ARGLIST."
-  (let* ((mapped-form (ad-map-arglists source-arglist target-arglist)))
-    (if (eq (car mapped-form) 'funcall)
-	(cons target-function (cdr (cdr mapped-form)))
-      (prog1 mapped-form
-	(setcar (cdr mapped-form) (list 'quote target-function))))))
-
-;; @@@ Making an advised documentation string:
-;; ===========================================
-;; New policy: The documentation string for an advised function will be built
-;; at the time the advised `documentation' function is called.  This has the
-;; following advantages:
-;;   1) command-key substitutions will automatically be correct
-;;   2) No wasted string space due to big advised docstrings in caches or
-;;      compiled files that contain preactivations
-;; The overall overhead for this should be negligible because people normally
-;; don't lookup documentation for the same function over and over again.
-
-(defun ad-make-single-advice-docstring (advice class &optional style)
-  (let ((advice-docstring (ad-docstring (ad-advice-definition advice))))
-    (cond ((eq style 'plain)
-	   advice-docstring)
-	  ((eq style 'freeze)
-	   (format "Permanent %s-advice `%s':%s%s"
-		   class (ad-advice-name advice)
-		   (if advice-docstring "\n" "")
-		   (or advice-docstring "")))
-	  (t (format "%s-advice `%s':%s%s"
-		     (capitalize (symbol-name class)) (ad-advice-name advice)
-		     (if advice-docstring "\n" "")
-		     (or advice-docstring ""))))))
-
-(defun ad-make-advised-docstring (function &optional style)
-  ;;"Constructs a documentation string for the advised FUNCTION.
-  ;;It concatenates the original documentation with the documentation
-  ;;strings of the individual pieces of advice which will be formatted
-  ;;according to STYLE.  STYLE can be `plain' or `freeze', everything else
-  ;;will be interpreted as `default'.  The order of the advice documentation
-  ;;strings corresponds to before/around/after and the individual ordering
-  ;;in any of these classes."
-  (let* ((origdef (ad-real-orig-definition function))
-	 (origtype (symbol-name (ad-definition-type origdef)))
-	 (origdoc
-	  ;; Retrieve raw doc, key substitution will be taken care of later:
-	  (ad-real-documentation origdef t))
-	 paragraphs advice-docstring)
-    (if origdoc (setq paragraphs (list origdoc)))
-    (if (not (eq style 'plain))
-	(setq paragraphs (cons (concat "This " origtype " is advised.")
-			       paragraphs)))
-    (ad-dolist (class ad-advice-classes)
-      (ad-dolist (advice (ad-get-enabled-advices function class))
-	(setq advice-docstring
-	      (ad-make-single-advice-docstring advice class style))
-	(if advice-docstring
-	    (setq paragraphs (cons advice-docstring paragraphs)))))
-    (if paragraphs
-	;; separate paragraphs with blank lines:
-	(mapconcat 'identity (nreverse paragraphs) "\n\n"))))
-
-(defun ad-make-plain-docstring (function)
-  (ad-make-advised-docstring function 'plain))
-(defun ad-make-freeze-docstring (function)
-  (ad-make-advised-docstring function 'freeze))
-
-;; @@@ Accessing overriding arglists and interactive forms:
-;; ========================================================
-
-(defun ad-advised-arglist (function)
-  ;;"Finds first defined arglist in FUNCTION's redefining advices."
-  (ad-dolist (advice (append (ad-get-enabled-advices function 'before)
-			     (ad-get-enabled-advices function 'around)
-			     (ad-get-enabled-advices function 'after)))
-    (let ((arglist (ad-arglist (ad-advice-definition advice))))
-      (if arglist
-	  ;; We found the first one, use it:
-	  (ad-do-return arglist)))))
-
-(defun ad-advised-interactive-form (function)
-  ;;"Finds first interactive form in FUNCTION's redefining advices."
-  (ad-dolist (advice (append (ad-get-enabled-advices function 'before)
-			     (ad-get-enabled-advices function 'around)
-			     (ad-get-enabled-advices function 'after)))
-    (let ((interactive-form
-	   (ad-interactive-form (ad-advice-definition advice))))
-      (if interactive-form
-	  ;; We found the first one, use it:
-	  (ad-do-return interactive-form)))))
-
-;; @@@ Putting it all together:
-;; ============================
-
-(defun ad-make-advised-definition (function)
-  ;;"Generates an advised definition of FUNCTION from its advice info."
-  (if (and (ad-is-advised function)
-	   (ad-has-redefining-advice function))
-      (let* ((origdef (ad-real-orig-definition function))
-	     (origname (ad-get-advice-info-field function 'origname))
-	     (orig-interactive-p (ad-interactive-p origdef))
-	     (orig-subr-p (ad-subr-p origdef))
-	     (orig-special-form-p (ad-special-form-p origdef))
-	     (orig-macro-p (ad-macro-p origdef))
-	     ;; Construct the individual pieces that we need for assembly:
-	     (orig-arglist (ad-arglist origdef function))
-	     (advised-arglist (or (ad-advised-arglist function)
-				  orig-arglist))
-	     (advised-interactive-form (ad-advised-interactive-form function))
-	     (interactive-form
-	      (cond (orig-macro-p nil)
-		    (advised-interactive-form)
-		    ((ad-interactive-form origdef))
-		    ;; Otherwise we must have a subr: make it interactive if
-		    ;; we have to and initialize required arguments in case
-		    ;; it is called interactively:
-		    (orig-interactive-p
-		     (let ((reqargs (car (ad-parse-arglist advised-arglist))))
-		       (if reqargs
-			   (` (interactive
-			       '(, (make-list (length reqargs) nil))))
-			   '(interactive))))))
-	     (orig-form
-	      (cond ((or orig-special-form-p orig-macro-p)
-		     ;; Special forms and macros will be advised into macros.
-                     ;; The trick is to construct an expansion for the advised
-		     ;; macro that does the correct thing when it gets eval'ed.
-		     ;; For macros we'll just use the expansion of the original
-		     ;; macro and return that. This way compiled advised macros
-		     ;; will be expanded into something useful. Note that after
-		     ;; advices have full control over whether they want to
-		     ;; evaluate the expansion (the value of `ad-return-value')
-		     ;; at macro expansion time or not. For special forms there
-		     ;; is no solution that interacts reasonably with the
-		     ;; compiler, hence we just evaluate the original at macro
-		     ;; expansion time and return the result. The moral of that
-		     ;; is that one should always deactivate advised special
-		     ;; forms before one byte-compiles a file.
-		     (` ((, (if orig-macro-p
-				'macroexpand
-			      'eval))
-			 (cons '(, origname)
-			       (, (ad-get-arguments advised-arglist 0))))))
-		    ((and orig-subr-p
-			  orig-interactive-p
-			  (not advised-interactive-form))
-		     ;; Check whether we were called interactively
-		     ;; in order to do proper prompting:
-		     (` (if (interactive-p)
-			    (call-interactively '(, origname))
-			  (, (ad-make-mapped-call
-			      orig-arglist advised-arglist origname)))))
-		    ;; And now for normal functions and non-interactive subrs
-	            ;; (or subrs whose interactive behavior was advised):
-		    (t (ad-make-mapped-call
-			advised-arglist orig-arglist origname)))))
-
-	;; Finally, build the sucker:
-	(ad-assemble-advised-definition
-	 (cond (orig-macro-p 'macro)
-	       (orig-special-form-p 'special-form)
-	       (t 'function))
-	 advised-arglist
-         (ad-make-advised-definition-docstring function)
-	 interactive-form
-	 orig-form
-	 (ad-get-enabled-advices function 'before)
-	 (ad-get-enabled-advices function 'around)
-	 (ad-get-enabled-advices function 'after)))))
-
-(defun ad-assemble-advised-definition
-  (type args docstring interactive orig &optional befores arounds afters)
-
-  ;;"Assembles an original and its advices into an advised function.
-  ;;It constructs a function or macro definition according to TYPE which has to
-  ;;be either `macro', `function' or `special-form'.  ARGS is the argument list
-  ;;that has to be used, DOCSTRING if non-nil defines the documentation of the
-  ;;definition, INTERACTIVE if non-nil is the interactive form to be used,
-  ;;ORIG is a form that calls the body of the original unadvised function,
-  ;;and BEFORES, AROUNDS and AFTERS are the lists of advices with which ORIG
-  ;;should be modified.  The assembled function will be returned."
-
-  (let (before-forms around-form around-form-protected after-forms definition)
-    (ad-dolist (advice befores)
-      (cond ((and (ad-advice-protected advice)
-		  before-forms)
-	     (setq before-forms
-		   (` ((unwind-protect
-			   (, (ad-prognify before-forms))
-			 (,@ (ad-body-forms
-			      (ad-advice-definition advice))))))))
-	    (t (setq before-forms
-		     (append before-forms
-			     (ad-body-forms (ad-advice-definition advice)))))))
-
-    (setq around-form (` (setq ad-return-value (, orig))))
-    (ad-dolist (advice (reverse arounds))
-      ;; If any of the around advices is protected then we
-      ;; protect the complete around advice onion:
-      (if (ad-advice-protected advice)
-	  (setq around-form-protected t))
-      (setq around-form
-	    (ad-substitute-tree
-	     (function (lambda (form) (eq form 'ad-do-it)))
-	     (function (lambda (form) around-form))
-	     (ad-prognify (ad-body-forms (ad-advice-definition advice))))))
-
-    (setq after-forms
-	  (if (and around-form-protected before-forms)
-	      (` ((unwind-protect
-		      (, (ad-prognify before-forms))
-		    (, around-form))))
-	    (append before-forms (list around-form))))
-    (ad-dolist (advice afters)
-      (cond ((and (ad-advice-protected advice)
-		  after-forms)
-	     (setq after-forms
-		   (` ((unwind-protect
-			   (, (ad-prognify after-forms))
-			 (,@ (ad-body-forms
-			      (ad-advice-definition advice))))))))
-	    (t (setq after-forms
-		     (append after-forms
-			     (ad-body-forms (ad-advice-definition advice)))))))
-
-    (setq definition
-	  (` ((,@ (if (memq type '(macro special-form)) '(macro)))
-	      lambda
-	      (, args)
-	      (,@ (if docstring (list docstring)))
-	      (,@ (if interactive (list interactive)))
-	      (let (ad-return-value)
-		(,@ after-forms)
-		(, (if (eq type 'special-form)
-		       '(list 'quote ad-return-value)
-		     'ad-return-value))))))
-
-    (ad-insert-argument-access-forms definition args)))
-
-;; This is needed for activation/deactivation hooks:
-(defun ad-make-hook-form (function hook-name)
-  ;;"Makes hook-form from FUNCTION's advice bodies in class HOOK-NAME."
-  (let ((hook-forms
-	 (mapcar (function (lambda (advice)
-			     (ad-body-forms (ad-advice-definition advice))))
-		 (ad-get-enabled-advices function hook-name))))
-    (if hook-forms
-	(ad-prognify (apply 'append hook-forms)))))
-
-
-;; @@ Caching:
-;; ===========
-;; Generating an advised definition of a function is moderately expensive,
-;; hence, it makes sense to cache it so we can reuse it in appropriate
-;; circumstances.  Of course, it only makes sense to reuse a cached
-;; definition if the current advice and function definition state is the
-;; same as it was at the time when the cached definition was generated.
-;; For that purpose we associate every cache with an id so we can verify
-;; if it is still valid at a certain point in time.  This id mechanism
-;; makes it possible to preactivate advised functions, write the compiled
-;; advised definitions to a file and reuse them during the actual
-;; activation without having to risk that the resulting definition will be
-;; incorrect, well, almost.
-;;
-;; A cache id is a list with six elements:
-;; 1) the list of names of enabled before advices
-;; 2) the list of names of enabled around advices
-;; 3) the list of names of enabled after advices
-;; 4) the type of the original function (macro, subr, etc.)
-;; 5) the arglist of the original definition (or t if it was equal to the
-;;    arglist of the cached definition)
-;; 6) t if the interactive form of the original definition was equal to the
-;;    interactive form of the cached definition
-;;
-;; Here's how a cache can get invalidated or be incorrect:
-;; A) a piece of advice used in the cache gets redefined
-;; B) the current list of enabled advices is different from the ones used
-;;    for the cache
-;; C) the type of the original function changed, e.g., a function became a
-;;    macro, or a subr became a function
-;; D) the arglist of the original function changed
-;; E) the interactive form of the original function changed
-;; F) a piece of advice used in the cache got redefined before the
-;;    defadvice with the cached definition got loaded: This is a PROBLEM!
-;;
-;; Cases A and B are the normal ones.  A is taken care of by `ad-add-advice'
-;; which clears the cache in such a case, B is easily checked during
-;; verification at activation time.
-;;
-;; Cases C, D and E have to be considered if one is slightly paranoid, i.e.,
-;; if one considers the case that the original function could be different
-;; from the one available at caching time (e.g., for forward advice of
-;; functions that get redefined by some packages - such as `eval-region' gets
-;; redefined by edebug).  All these cases can be easily checked during
-;; verification.  Element 4 of the id lets one check case C, element 5 takes
-;; care of case D (using t in the equality case saves some space, because the
-;; arglist can be recovered at validation time from the cached definition),
-;; and element 6 takes care of case E which is only a problem if the original
-;; was actually a function whose interactive form was not overridden by a
-;; piece of advice.
-;;
-;; Case F is the only one which will lead to an incorrect advised function.
-;; There is no way to avoid this without storing the complete advice definition
-;; in the cache-id which is not feasible.
-;;
-;; The cache-id of a typical advised function with one piece of advice and
-;; no arglist redefinition takes 7 conses which is a small price to pay for
-;; the added efficiency.  The validation itself is also pretty cheap, certainly
-;; a lot cheaper than reconstructing an advised definition.
-
-(defmacro ad-get-cache-definition (function)
-  (` (car (ad-get-advice-info-field (, function) 'cache))))
-
-(defmacro ad-get-cache-id (function)
-  (` (cdr (ad-get-advice-info-field (, function) 'cache))))
-
-(defmacro ad-set-cache (function definition id)
-  (` (ad-set-advice-info-field
-      (, function) 'cache (cons (, definition) (, id)))))
-
-(defun ad-clear-cache (function)
-  "Clears a previously cached advised definition of FUNCTION.
-Clear the cache if you want to force `ad-activate' to construct a new
-advised definition from scratch."
-  (interactive
-   (list (ad-read-advised-function "Clear cached definition of: ")))
-  (ad-set-advice-info-field function 'cache nil))
-
-(defun ad-make-cache-id (function)
-  ;;"Generates an identifying image of the current advices of FUNCTION."
-  (let ((original-definition (ad-real-orig-definition function))
-	(cached-definition (ad-get-cache-definition function)))
-    (list (mapcar (function (lambda (advice) (ad-advice-name advice)))
-		  (ad-get-enabled-advices function 'before))
-	  (mapcar (function (lambda (advice) (ad-advice-name advice)))
-		  (ad-get-enabled-advices function 'around))
-	  (mapcar (function (lambda (advice) (ad-advice-name advice)))
-		  (ad-get-enabled-advices function 'after))
-	  (ad-definition-type original-definition)
-	  (if (equal (ad-arglist original-definition function)
-		     (ad-arglist cached-definition))
-	      t
-	    (ad-arglist original-definition function))
-	  (if (eq (ad-definition-type original-definition) 'function)
-	      (equal (ad-interactive-form original-definition)
-		     (ad-interactive-form cached-definition))))))
-
-(defun ad-get-cache-class-id (function class)
-  ;;"Returns the part of FUNCTION's cache id that identifies CLASS."
-  (let ((cache-id (ad-get-cache-id function)))
-    (if (eq class 'before)
-	(car cache-id)
-      (if (eq class 'around)
-	  (nth 1 cache-id)
-	(nth 2 cache-id)))))
-
-(defun ad-verify-cache-class-id (cache-class-id advices)
-  (ad-dolist (advice advices (null cache-class-id))
-    (if (ad-advice-enabled advice)
-	(if (eq (car cache-class-id) (ad-advice-name advice))
-	    (setq cache-class-id (cdr cache-class-id))
-	  (ad-do-return nil)))))
-
-;; There should be a way to monitor if and why a cache verification failed
-;; in order to determine whether a certain preactivation could be used or
-;; not.  Right now the only way to find out is to trace 
-;; `ad-cache-id-verification-code'.  The code it returns indicates where the
-;; verification failed.  Tracing `ad-verify-cache-class-id' might provide
-;; some additional useful information.
-
-(defun ad-cache-id-verification-code (function)
-  (let ((cache-id (ad-get-cache-id function))
-	(code 'before-advice-mismatch))
-    (and (ad-verify-cache-class-id
-	  (car cache-id) (ad-get-advice-info-field function 'before))
-	 (setq code 'around-advice-mismatch)
-	 (ad-verify-cache-class-id
-	  (nth 1 cache-id) (ad-get-advice-info-field function 'around))
-	 (setq code 'after-advice-mismatch)
-	 (ad-verify-cache-class-id
-	  (nth 2 cache-id) (ad-get-advice-info-field function 'after))
-	 (setq code 'definition-type-mismatch)
-	 (let ((original-definition (ad-real-orig-definition function))
-	       (cached-definition (ad-get-cache-definition function)))
-	   (and (eq (nth 3 cache-id) (ad-definition-type original-definition))
-		(setq code 'arglist-mismatch)
-		(equal (if (eq (nth 4 cache-id) t)
-			   (ad-arglist original-definition function)
-			 (nth 4 cache-id) )
-		       (ad-arglist cached-definition))
-		(setq code 'interactive-form-mismatch)
-		(or (null (nth 5 cache-id))
-		    (equal (ad-interactive-form original-definition)
-			   (ad-interactive-form cached-definition)))
-		(setq code 'verified))))
-    code))
-
-(defun ad-verify-cache-id (function)
-  ;;"True if FUNCTION's cache-id is compatible with its current advices."
-  (eq (ad-cache-id-verification-code function) 'verified))
-
-
-;; @@ Preactivation:
-;; =================
-;; Preactivation can be used to generate compiled advised definitions
-;; at compile time without having to give up the dynamic runtime flexibility
-;; of the advice mechanism.  Preactivation is a special feature of `defadvice',
-;; it involves the following steps:
-;;  - remembering the function's current state (definition and advice-info)
-;;  - advising it with the defined piece of advice
-;;  - clearing its cache
-;;  - generating an interpreted advised definition by activating it, this will
-;;    make use of all its current active advice and its current definition
-;;  - saving the so generated cached definition and id
-;;  - resetting the function's advice and definition state to what it was
-;;    before the preactivation
-;;  - Returning the saved definition and its id to be used in the expansion of
-;;    `defadvice' to assign it as an initial cache, hence it will be compiled
-;;    at time the `defadvice' gets compiled.
-;; Naturally, for preactivation to be effective it has to be applied/compiled
-;; at the right time, i.e., when the current state of advices and function
-;; definition exactly reflects the state at activation time.  Should that not
-;; be the case, the precompiled definition will just be discarded and a new
-;; advised definition will be generated.
-
-(defun ad-preactivate-advice (function advice class position)
-  ;;"Preactivates FUNCTION and returns the constructed cache."
-  (let* ((function-defined-p (fboundp function))
-	 (old-definition
-	  (if function-defined-p
-	      (symbol-function function)))
-	 (old-advice-info (ad-copy-advice-info function))
-	 (ad-advised-functions ad-advised-functions))
-    (unwind-protect
-	(progn
-	  (ad-add-advice function advice class position)
-	  (ad-enable-advice function class (ad-advice-name advice))
-	  (ad-clear-cache function)
-	  (ad-activate-on function -1)
-	  (if (and (ad-is-active function)
-	           (ad-get-cache-definition function))
-	      (list (ad-get-cache-definition function)
-		    (ad-get-cache-id function))))
-      (ad-set-advice-info function old-advice-info)
-      ;; Don't `fset' function to nil if it was previously unbound:
-      (if function-defined-p
-	  (ad-safe-fset function old-definition)
-	(fmakunbound function)))))
-
-
-;; @@ Freezing:
-;; ============
-;; Freezing transforms a `defadvice' into a redefining `defun/defmacro'
-;; for the advised function without keeping any advice information. This
-;; feature was jwz's idea: It generates a dumpable function definition
-;; whose documentation can be written to the DOC file, and the generated
-;; code does not need any Advice runtime support. Of course, frozen advices
-;; cannot be undone.
-
-;; Freezing only considers the advice of the particular `defadvice', other
-;; already existing advices for the same function will be ignored. To ensure
-;; proper interaction when an already advised function gets redefined with
-;; a frozen advice, frozen advices always use the actual original definition
-;; of the function, i.e., they are always at the core of the onion. E.g., if
-;; an already advised function gets redefined with a frozen advice and then
-;; unadvised, the frozen advice remains as the new definition of the function.
-
-;; While multiple freeze advices for a single function or freeze-advising
-;; of an already advised function are possible, they are better avoided,
-;; because definition/compile/load ordering is relevant, and it becomes
-;; incomprehensible pretty quickly.
-
-(defun ad-make-freeze-definition (function advice class position)
-  (if (not (ad-has-proper-definition function))
-      (error
-       "ad-make-freeze-definition: `%s' is not yet defined"
-       function))
-  (let* ((name (ad-advice-name advice))
-	 ;; With a unique origname we can have multiple freeze advices
-	 ;; for the same function, each overloading the previous one:
-	 (unique-origname
-	  (intern (format "%s-%s-%s" (ad-make-origname function) class name)))
-	 (orig-definition
-	  ;; If FUNCTION is already advised, we'll use its current origdef
-	  ;; as the original definition of the frozen advice:
-	  (or (ad-get-orig-definition function)
-	      (symbol-function function)))
-	 (old-advice-info
-	  (if (ad-is-advised function)
-	      (ad-copy-advice-info function)))
-	 (real-docstring-fn
-	  (symbol-function 'ad-make-advised-definition-docstring))
-	 (real-origname-fn
-	  (symbol-function 'ad-make-origname))
-	 (frozen-definition
-	  (unwind-protect
-	      (progn
-		;; Make sure we construct a proper docstring:
-		(ad-safe-fset 'ad-make-advised-definition-docstring
-			      'ad-make-freeze-docstring)
-		;; Make sure `unique-origname' is used as the origname:
-		(ad-safe-fset 'ad-make-origname '(lambda (x) unique-origname))
-		;; No we reset all current advice information to nil and
-		;; generate an advised definition that's solely determined
-		;; by ADVICE and the current origdef of FUNCTION:
-		(ad-set-advice-info function nil)
-		(ad-add-advice function advice class position)
-		;; The following will provide proper real docstrings as
-		;; well as a definition that will make the compiler happy:
-		(ad-set-orig-definition function orig-definition)
-		(ad-make-advised-definition function))
-	    ;; Restore the old advice state:
-	    (ad-set-advice-info function old-advice-info)
-	    ;; Restore functions:
-	    (ad-safe-fset
-	     'ad-make-advised-definition-docstring real-docstring-fn)
-	    (ad-safe-fset 'ad-make-origname real-origname-fn))))
-    (if frozen-definition
-	(let* ((macro-p (ad-macro-p frozen-definition))
-	       (body (cdr (if macro-p
-			      (ad-lambdafy frozen-definition)
-			    frozen-definition))))
-	  (` (progn
-	       (if (not (fboundp '(, unique-origname)))
-		   (fset '(, unique-origname)
-			 ;; avoid infinite recursion in case the function
-			 ;; we want to freeze is already advised:
-			 (or (ad-get-orig-definition '(, function))
-			     (symbol-function '(, function)))))
-	       ((, (if macro-p 'defmacro 'defun))
-		(, function)
-		(,@ body))))))))
-
-
-;; @@ Activation and definition handling:
-;; ======================================
-
-(defun ad-should-compile (function compile)
-  ;;"Returns non-nil if the advised FUNCTION should be compiled.
-  ;;If COMPILE is non-nil and not a negative number then it returns t.
-  ;;If COMPILE is a negative number then it returns nil.
-  ;;If COMPILE is nil then the result depends on the value of
-  ;;`ad-default-compilation-action' (which see)."
-  (if (integerp compile)
-      (>= compile 0)
-    (if compile
-	compile
-      (cond ((eq ad-default-compilation-action 'never)
-	     nil)
-	    ((eq ad-default-compilation-action 'always)
-	     t)
-	    ((eq ad-default-compilation-action 'like-original)
-	     (or (ad-subr-p (ad-get-orig-definition function))
-		 (ad-compiled-p (ad-get-orig-definition function))))
-	    ;; everything else means `maybe':
-	    (t (featurep 'byte-compile))))))
-
-(defun ad-activate-advised-definition (function compile)
-  ;;"Redefines FUNCTION with its advised definition from cache or scratch.
-  ;;The resulting FUNCTION will be compiled if `ad-should-compile' returns t.
-  ;;The current definition and its cache-id will be put into the cache."
-  (let ((verified-cached-definition
-	 (if (ad-verify-cache-id function)
-	     (ad-get-cache-definition function))))
-    (ad-safe-fset function
-		  (or verified-cached-definition
-		      (ad-make-advised-definition function)))
-    (if (ad-should-compile function compile)
-	(ad-compile-function function))
-    (if verified-cached-definition
-	(if (not (eq verified-cached-definition (symbol-function function)))
-	    ;; we must have compiled, cache the compiled definition:
-	    (ad-set-cache
-	     function (symbol-function function) (ad-get-cache-id function)))
-      ;; We created a new advised definition, cache it with a proper id:
-      (ad-clear-cache function)
-      ;; ad-make-cache-id needs the new cached definition:
-      (ad-set-cache function (symbol-function function) nil)
-      (ad-set-cache
-       function (symbol-function function) (ad-make-cache-id function)))))
-
-(defun ad-handle-definition (function)
-  "Handles re/definition of an advised FUNCTION during de/activation.
-If FUNCTION does not have an original definition associated with it and
-the current definition is usable, then it will be stored as FUNCTION's
-original definition.  If no current definition is available (even in the
-case of undefinition) nothing will be done.  In the case of redefinition
-the action taken depends on the value of `ad-redefinition-action' (which
-see).  Redefinition occurs when FUNCTION already has an original definition
-associated with it but got redefined with a new definition and then
-de/activated.  If you do not like the current redefinition action change
-the value of `ad-redefinition-action' and de/activate again."
-  (let ((original-definition (ad-get-orig-definition function))
-	(current-definition (if (ad-real-definition function)
-				(symbol-function function))))
-    (if original-definition
-	(if current-definition
-	    (if (and (not (eq current-definition original-definition))
-		     ;; Redefinition with an advised definition from a
-		     ;; different function won't count as such:
-		     (not (ad-advised-definition-p current-definition)))
-		;; we have a redefinition:
-		(if (not (memq ad-redefinition-action '(accept discard warn)))
-		    (error "ad-handle-definition (see its doc): `%s' %s"
-			   function "illegally redefined")
-		  (if (eq ad-redefinition-action 'discard)
-		      (ad-safe-fset function original-definition)
-		    (ad-set-orig-definition function current-definition)
-		    (if (eq ad-redefinition-action 'warn)
-			(message "ad-handle-definition: `%s' got redefined"
-				 function))))
-	      ;; either advised def or correct original is in place:
-	      nil)
-	  ;; we have an undefinition, ignore it:
-	  nil)
-      (if current-definition
-	  ;; we have a first definition, save it as original:
-	  (ad-set-orig-definition function current-definition)
-	;; we don't have anything noteworthy:
-	nil))))
-
-
-;; @@ The top-level advice interface:
-;; ==================================
-
-(defun ad-activate-on (function &optional compile)
-  "Activates all the advice information of an advised FUNCTION.
-If FUNCTION has a proper original definition then an advised
-definition will be generated from FUNCTION's advice info and the
-definition of FUNCTION will be replaced with it.  If a previously
-cached advised definition was available, it will be used.
-The optional COMPILE argument determines whether the resulting function
-or a compilable cached definition will be compiled.  If it is negative
-no compilation will be performed, if it is positive or otherwise non-nil
-the resulting function will be compiled, if it is nil the behavior depends
-on the value of `ad-default-compilation-action' (which see).
-Activation of an advised function that has an advice info but no actual
-pieces of advice is equivalent to a call to `ad-unadvise'.  Activation of
-an advised function that has actual pieces of advice but none of them are
-enabled is equivalent to a call to `ad-deactivate'.  The current advised
-definition will always be cached for later usage."
-  (interactive
-   (list (ad-read-advised-function "Activate advice of: ")
-	 current-prefix-arg))
-  (if ad-activate-on-top-level
-      ;; avoid recursive calls to `ad-activate-on':
-      (ad-with-auto-activation-disabled
-	(if (not (ad-is-advised function))
-	    (error "ad-activate: `%s' is not advised" function)
-	  (ad-handle-definition function)
-	  ;; Just return for forward advised and not yet defined functions:
-	  (if (ad-get-orig-definition function)
-	      (if (not (ad-has-any-advice function))
-		  (ad-unadvise function)
-		;; Otherwise activate the advice:
-		(cond ((ad-has-redefining-advice function)
-		       (ad-activate-advised-definition function compile)
-		       (ad-set-advice-info-field function 'active t)
-		       (eval (ad-make-hook-form function 'activation))
-		       function)
-		      ;; Here we are if we have all disabled advices:
-		      (t (ad-deactivate function)))))))))
-
-(defun ad-deactivate (function)
-  "Deactivates the advice of an actively advised FUNCTION.
-If FUNCTION has a proper original definition, then the current
-definition of FUNCTION will be replaced with it.  All the advice
-information will still be available so it can be activated again with
-a call to `ad-activate'."
-  (interactive
-   (list (ad-read-advised-function "Deactivate advice of: " 'ad-is-active)))
-  (if (not (ad-is-advised function))
-      (error "ad-deactivate: `%s' is not advised" function)
-    (cond ((ad-is-active function)
-	   (ad-handle-definition function)
-	   (if (not (ad-get-orig-definition function))
-	       (error "ad-deactivate: `%s' has no original definition"
-		      function)
-	     (ad-safe-fset function (ad-get-orig-definition function))
-	     (ad-set-advice-info-field function 'active nil)
-	     (eval (ad-make-hook-form function 'deactivation))
-	     function)))))
-
-(defun ad-update (function &optional compile)
-  "Update the advised definition of FUNCTION if its advice is active.
-See `ad-activate-on' for documentation on the optional COMPILE argument."
-  (interactive
-   (list (ad-read-advised-function
-	  "Update advised definition of: " 'ad-is-active)))
-  (if (ad-is-active function)
-      (ad-activate-on function compile)))
-
-(defun ad-unadvise (function)
-  "Deactivates FUNCTION and then removes all its advice information. 
-If FUNCTION was not advised this will be a noop."
-  (interactive
-   (list (ad-read-advised-function "Unadvise function: ")))
-  (cond ((ad-is-advised function)
-	 (if (ad-is-active function)
-	     (ad-deactivate function))
-	 (ad-clear-orig-definition function)
-	 (ad-set-advice-info function nil)
-	 (ad-pop-advised-function function))))
-
-(defun ad-recover (function)
-  "Tries to recover FUNCTION's original definition and unadvises it.
-This is more low-level than `ad-unadvise' because it does not do any
-deactivation which might run hooks and get into other trouble.
-Use in emergencies."
-  ;; Use more primitive interactive behavior here: Accept any symbol that's
-  ;; currently defined in obarray, not necessarily with a function definition:
-  (interactive
-   (list (intern
-	  (completing-read "Recover advised function: " obarray nil t))))
-  (cond ((ad-is-advised function)
-	 (cond ((ad-get-orig-definition function)
-	        (ad-safe-fset function (ad-get-orig-definition function))
-		(ad-clear-orig-definition function)))
-	 (ad-set-advice-info function nil)
-	 (ad-pop-advised-function function))))
-
-(defun ad-activate-regexp (regexp &optional compile)
-  "Activates functions with an advice name containing a REGEXP match.
-See `ad-activate-on' for documentation on the optional COMPILE argument."
-  (interactive
-   (list (ad-read-regexp "Activate via advice regexp: ")
-	 current-prefix-arg))
-  (ad-do-advised-functions (function)
-    (if (ad-find-some-advice function 'any regexp)
-	(ad-activate-on function compile))))
-
-(defun ad-deactivate-regexp (regexp)
-  "Deactivates functions with an advice name containing REGEXP match."
-  (interactive
-   (list (ad-read-regexp "Deactivate via advice regexp: ")))
-  (ad-do-advised-functions (function)
-    (if (ad-find-some-advice function 'any regexp)
-	(ad-deactivate function))))
-
-(defun ad-update-regexp (regexp &optional compile)
-  "Updates functions with an advice name containing a REGEXP match.
-See `ad-activate-on' for documentation on the optional COMPILE argument."
-  (interactive
-   (list (ad-read-regexp "Update via advice regexp: ")
-	 current-prefix-arg))
-  (ad-do-advised-functions (function)
-    (if (ad-find-some-advice function 'any regexp)
-	(ad-update function compile))))
-
-(defun ad-activate-all (&optional compile)
-  "Activates all currently advised functions.
-See `ad-activate-on' for documentation on the optional COMPILE argument."
-  (interactive "P")
-  (ad-do-advised-functions (function)
-    (ad-activate-on function compile)))
-
-(defun ad-deactivate-all ()
-  "Deactivates all currently advised functions."
-  (interactive)
-  (ad-do-advised-functions (function)
-    (ad-deactivate function)))
-
-(defun ad-update-all (&optional compile)
-  "Updates all currently advised functions.
-With prefix argument compiles resulting advised definitions."
-  (interactive "P")
-  (ad-do-advised-functions (function)
-    (ad-update function compile)))
-
-(defun ad-unadvise-all ()
-  "Unadvises all currently advised functions."
-  (interactive)
-  (ad-do-advised-functions (function)
-    (ad-unadvise function)))
-
-(defun ad-recover-all ()
-  "Recovers all currently advised functions.  Use in emergencies."
-  (interactive)
-  (ad-do-advised-functions (function)
-    (condition-case nil
-	(ad-recover function)
-      (error nil))))
-
-
-;; Completion alist of legal `defadvice' flags
-(defvar ad-defadvice-flags
-  '(("protect") ("disable") ("activate")
-    ("compile") ("preactivate") ("freeze")))
-
-;;;###autoload
-(defmacro defadvice (function args &rest body)
-  "Defines a piece of advice for FUNCTION (a symbol).
-The syntax of `defadvice' is as follows:
-
-  (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...)
-    [DOCSTRING] [INTERACTIVE-FORM]
-    BODY... )
-
-FUNCTION ::= Name of the function to be advised.
-CLASS ::= `before' | `around' | `after' | `activation' | `deactivation'.
-NAME ::= Non-nil symbol that names this piece of advice.
-POSITION ::= `first' | `last' | NUMBER. Optional, defaults to `first',
-    see also `ad-add-advice'.
-ARGLIST ::= An optional argument list to be used for the advised function
-    instead of the argument list of the original.  The first one found in
-    before/around/after-advices will be used.
-FLAG ::= `protect'|`disable'|`activate'|`compile'|`preactivate'|`freeze'.
-    All flags can be specified with unambiguous initial substrings.
-DOCSTRING ::= Optional documentation for this piece of advice.
-INTERACTIVE-FORM ::= Optional interactive form to be used for the advised
-    function.  The first one found in before/around/after-advices will be used.
-BODY ::= Any s-expression.
-
-Semantics of the various flags:
-`protect': The piece of advice will be protected against non-local exits in
-any code that precedes it.  If any around-advice of a function is protected
-then automatically all around-advices will be protected (the complete onion).
-
-`activate': All advice of FUNCTION will be activated immediately if
-FUNCTION has been properly defined prior to this application of `defadvice'.
-
-`compile': In conjunction with `activate' specifies that the resulting
-advised function should be compiled.
-
-`disable': The defined advice will be disabled, hence, it will not be used 
-during activation until somebody enables it.
-
-`preactivate': Preactivates the advised FUNCTION at macro-expansion/compile
-time.  This generates a compiled advised definition according to the current
-advice state that will be used during activation if appropriate.  Only use
-this if the `defadvice' gets actually compiled.
-
-`freeze': Expands the `defadvice' into a redefining `defun/defmacro' according
-to this particular single advice.  No other advice information will be saved.
-Frozen advices cannot be undone, they behave like a hard redefinition of
-the advised function.  `freeze' implies `activate' and `preactivate'.  The
-documentation of the advised function can be dumped onto the `DOC' file
-during preloading.
-
-Look at the file `advice.el' for comprehensive documentation."
-  (if (not (ad-name-p function))
-      (error "defadvice: Illegal function name: %s" function))
-  (let* ((class (car args))
-	 (name (if (not (ad-class-p class))
-		   (error "defadvice: Illegal advice class: %s" class)
-		 (nth 1 args)))
-	 (position (if (not (ad-name-p name))
-		       (error "defadvice: Illegal advice name: %s" name)
-		     (setq args (nthcdr 2 args))
-		     (if (ad-position-p (car args))
-			 (prog1 (car args)
-			   (setq args (cdr args))))))
-	 (arglist (if (listp (car args))
-		      (prog1 (car args)
-			(setq args (cdr args)))))
-	 (flags
-	  (mapcar
-	   (function
-	    (lambda (flag)
-	      (let ((completion
-		     (try-completion (symbol-name flag) ad-defadvice-flags)))
-		(cond ((eq completion t) flag)
-		      ((assoc completion ad-defadvice-flags)
-		       (intern completion))
-		      (t (error "defadvice: Illegal or ambiguous flag: %s"
-				flag))))))
-	   args))
-	 (advice (ad-make-advice
-		  name (memq 'protect flags)
-		  (not (memq 'disable flags))
-		  (` (advice lambda (, arglist) (,@ body)))))
-	 (preactivation (if (memq 'preactivate flags)
-			    (ad-preactivate-advice
-			     function advice class position))))
-    ;; Now for the things to be done at evaluation time:
-    (if (memq 'freeze flags)
-	;; jwz's idea: Freeze the advised definition into a dumpable
-	;; defun/defmacro whose docs can be written to the DOC file:
-	(ad-make-freeze-definition function advice class position)
-      ;; the normal case:	 
-      (` (progn
-	   (ad-add-advice '(, function) '(, advice) '(, class) '(, position))
-	   (,@ (if preactivation
-		   (` ((ad-set-cache
-			'(, function)
-			;; the function will get compiled:
-			(, (cond ((ad-macro-p (car preactivation))
-				  (` (ad-macrofy
-				      (function
-				       (, (ad-lambdafy
-					   (car preactivation)))))))
-				 (t (` (function
-					(, (car preactivation)))))))
-			'(, (car (cdr preactivation))))))))
-	   (,@ (if (memq 'activate flags)
-		   (` ((ad-activate-on '(, function)
-				       (, (if (memq 'compile flags) t)))))))
-	   '(, function))))))
-
-
-;; @@ Tools:
-;; =========
-
-(defmacro ad-with-originals (functions &rest body)
-  "Binds FUNCTIONS to their original definitions and executes BODY.
-For any members of FUNCTIONS that are not currently advised the rebinding will
-be a noop.  Any modifications done to the definitions of FUNCTIONS will be
-undone on exit of this macro."
-  (let* ((index -1)
-	 ;; Make let-variables to store current definitions:
-	 (current-bindings
-	  (mapcar (function
-		   (lambda (function)
-		     (setq index (1+ index))
-		     (list (intern (format "ad-oRiGdEf-%d" index))
-			   (` (symbol-function '(, function))))))
-		  functions)))
-    (` (let (, current-bindings)
-	 (unwind-protect
-	     (progn
-	       (,@ (progn
-		     ;; Make forms to redefine functions to their
-		     ;; original definitions if they are advised:
-		     (setq index -1)
-		     (mapcar
-		      (function
-		       (lambda (function)
-			 (setq index (1+ index))
-			 (` (ad-safe-fset
-			     '(, function)
-			     (or (ad-get-orig-definition '(, function))
-				 (, (car (nth index current-bindings))))))))
-		      functions)))
-	       (,@ body))
-	   (,@ (progn
-		 ;; Make forms to back-define functions to the definitions
-		 ;; they had outside this macro call:
-		 (setq index -1)
-		 (mapcar
-		  (function
-		   (lambda (function)
-		     (setq index (1+ index))
-		     (` (ad-safe-fset
-			 '(, function)
-			 (, (car (nth index current-bindings)))))))
-		  functions))))))))
-
-(if (not (get 'ad-with-originals 'lisp-indent-hook))
-    (put 'ad-with-originals 'lisp-indent-hook 1))
-
-
-;; @@ Advising `documentation':
-;; ============================
-;; Use the advice mechanism to advise `documentation' to make it
-;; generate proper documentation strings for advised definitions:
-
-(defadvice documentation (after ad-advised-docstring first disable preact)
-  "Builds an advised docstring if FUNCTION is advised."
-  ;; Because we get the function name from the advised docstring
-  ;; this will work for function names as well as for definitions:
-  (if (and (stringp ad-return-value)
-	   (string-match
-	    ad-advised-definition-docstring-regexp ad-return-value))
-      (let ((function
-	     (car (read-from-string
-		   ad-return-value (match-beginning 1) (match-end 1)))))
-	(cond ((ad-is-advised function)
-	       (setq ad-return-value (ad-make-advised-docstring function))
-	       ;; Handle optional `raw' argument: 
-	       (if (not (ad-get-arg 1))
-		   (setq ad-return-value
-			 (substitute-command-keys ad-return-value))))))))
-
-
-;; @@ Starting, stopping and recovering from the advice package magic:
-;; ===================================================================
-
-(defun ad-start-advice ()
-  "Starts the automatic advice handling magic."
-  (interactive)
-  ;; Advising `ad-activate' means death!!
-  (ad-set-advice-info 'ad-activate nil)
-  (ad-safe-fset 'ad-activate 'ad-activate-on)
-  (ad-enable-advice 'documentation 'after 'ad-advised-docstring)
-  (ad-activate-on 'documentation 'compile))
-
-(defun ad-stop-advice ()
-  "Stops the automatic advice handling magic.
-You should only need this in case of Advice-related emergencies."
-  (interactive)
-  ;; Advising `ad-activate' means death!!
-  (ad-set-advice-info 'ad-activate nil)
-  (ad-disable-advice 'documentation 'after 'ad-advised-docstring)
-  (ad-update 'documentation)
-  (ad-safe-fset 'ad-activate 'ad-activate-off))
-
-(defun ad-recover-normality ()
-  "Undoes all advice related redefinitions and unadvises everything. 
-Use only in REAL emergencies."
-  (interactive)
-  ;; Advising `ad-activate' means death!!
-  (ad-set-advice-info 'ad-activate nil)
-  (ad-safe-fset 'ad-activate 'ad-activate-off)
-  (ad-recover-all)
-  (setq ad-advised-functions nil))
-
-;; Until the Advice-related changes to `data.c' are part of Lemacs we
-;; have to load the old implementation of advice activation hooks:
-(if (ad-lemacs-p)
-    (require 'ad-hooks))
-
-(ad-start-advice)
-
-(provide 'advice)
-
-;;; advice.el ends here
diff --git a/lisp/emacs-lisp/assoc.el b/lisp/emacs-lisp/assoc.el
deleted file mode 100644
index 997badc1732..00000000000
--- a/lisp/emacs-lisp/assoc.el
+++ /dev/null
@@ -1,140 +0,0 @@
-;;; assoc.el --- insert/delete/sort functions on association lists
-
-;; Copyright (C) 1996 Free Software Foundation, Inc.
-
-;; Author: Barry A. Warsaw <bwarsaw@cen.com>
-;; Keywords: extensions
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Association list utilities providing insertion, deletion, sorting
-;; fetching off key-value pairs in association lists.
-
-;;; Code:
-
-(defun asort (alist-symbol key)
-  "Move a specified key-value pair to the head of an alist.
-The alist is referenced by ALIST-SYMBOL. Key-value pair to move to
-head is one matching KEY.  Returns the sorted list and doesn't affect
-the order of any other key-value pair.  Side effect sets alist to new
-sorted list."
-  (set alist-symbol
-       (sort (copy-alist (eval alist-symbol))
-	     (function (lambda (a b) (equal (car a) key))))))
-
-
-(defun aelement (key value)
-  "Makes a list of a cons cell containing car of KEY and cdr of VALUE.
-The returned list is suitable as an element of an alist."
-  (list (cons key value)))
-
-
-(defun aheadsym (alist)
-  "Return the key symbol at the head of ALIST."
-  (car (car alist)))
-
-
-(defun anot-head-p (alist key)
-  "Find out if a specified key-value pair is not at the head of an alist.
-The alist to check is specified by ALIST and the key-value pair is the
-one matching the supplied KEY.  Returns nil if ALIST is nil, or if
-key-value pair is at the head of the alist.  Returns t if key-value
-pair is not at the head of alist.  ALIST is not altered."
-  (not (equal (aheadsym alist) key)))
-
-
-(defun aput (alist-symbol key &optional value)
-  "Inserts a key-value pair into an alist.
-The alist is referenced by ALIST-SYMBOL. The key-value pair is made
-from KEY and optionally, VALUE. Returns the altered alist or nil if
-ALIST is nil.
-
-If the key-value pair referenced by KEY can be found in the alist, and
-VALUE is supplied non-nil, then the value of KEY will be set to VALUE.
-If VALUE is not supplied, or is nil, the key-value pair will not be
-modified, but will be moved to the head of the alist. If the key-value
-pair cannot be found in the alist, it will be inserted into the head
-of the alist (with value nil if VALUE is nil or not supplied)."
-  (let ((elem (aelement key value))
-	alist)
-    (asort alist-symbol key)
-    (setq alist (eval alist-symbol))
-    (cond ((null alist) (set alist-symbol elem))
-	  ((anot-head-p alist key) (set alist-symbol (nconc elem alist)))
-	  (value (setcar alist (car elem)))
-	  (t alist))))
-
-
-(defun adelete (alist-symbol key)
-  "Delete a key-value pair from the alist.
-Alist is referenced by ALIST-SYMBOL and the key-value pair to remove
-is pair matching KEY.  Returns the altered alist."
-  (asort alist-symbol key)
-  (let ((alist (eval alist-symbol)))
-    (cond ((null alist) nil)
-	  ((anot-head-p alist key) alist)
-	  (t (set alist-symbol (cdr alist))))))
-
-
-(defun aget (alist key &optional keynil-p)
-  "Returns the value in ALIST that is associated with KEY.
-Optional KEYNIL-P describes what to do if the value associated with
-KEY is nil.  If KEYNIL-P is not supplied or is nil, and the value is
-nil, then KEY is returned.  If KEYNIL-P is non-nil, then nil would be
-returned.
-
-If no key-value pair matching KEY could be found in ALIST, or ALIST is
-nil then nil is returned. ALIST is not altered."
-  (let ((copy (copy-alist alist)))
-    (cond ((null alist) nil)
-	  ((progn (asort 'copy key)
-		  (anot-head-p copy key)) nil)
-	  ((cdr (car copy)))
-	  (keynil-p nil)
-	  ((car (car copy)))
-	  (t nil))))
-
-
-(defun amake (alist-symbol keylist &optional valuelist)
-  "Make an association list.
-The association list is attached to the alist referenced by
-ALIST-SYMBOL. Each element in the KEYLIST becomes a key and is
-associated with the value in VALUELIST with the same index. If
-VALUELIST is not supplied or is nil, then each key in KEYLIST is
-associated with nil.
-
-KEYLIST and VALUELIST should have the same number of elements, but
-this isn't enforced.  If VALUELIST is smaller than KEYLIST, remaining
-keys are associated with nil.  If VALUELIST is larger than KEYLIST,
-extra values are ignored.  Returns the created alist."
-  (let ((keycar (car keylist))
-	(keycdr (cdr keylist))
-	(valcar (car valuelist))
-	(valcdr (cdr valuelist)))
-    (cond ((null keycdr)
-	   (aput alist-symbol keycar valcar))
-	  (t
-	   (amake alist-symbol keycdr valcdr)
-	   (aput alist-symbol keycar valcar))))
-  (eval alist-symbol))
-
-(provide 'assoc)
-
-;;; assoc.el ends here
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
deleted file mode 100644
index 4614a5c42cb..00000000000
--- a/lisp/emacs-lisp/autoload.el
+++ /dev/null
@@ -1,416 +0,0 @@
-;;; autoload.el --- maintain autoloads in loaddefs.el.
-
-;; Copyright (C) 1991, 92, 93, 94, 95, 96 Free Software Foundation, Inc.
-
-;; Author: Roland McGrath <roland@gnu.ai.mit.edu>
-;; Keywords: maint
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This code helps GNU Emacs maintainers keep the loaddefs.el file up to
-;; date.  It interprets magic cookies of the form ";;;###autoload" in
-;; lisp source files in various useful ways.  To learn more, read the
-;; source; if you're going to use this, you'd better be able to.
-
-;;; Code:
-
-(defun make-autoload (form file)
-  "Turn FORM, a defun or defmacro, into an autoload for source file FILE.
-Returns nil if FORM is not a defun, define-skeleton or defmacro."
-  (let ((car (car-safe form)))
-    (if (memq car '(defun define-skeleton defmacro))
-	(let ((macrop (eq car 'defmacro))
-	      name doc)
-	  (setq form (cdr form)
-		name (car form)
-		;; Ignore the arguments.
-		form (cdr (if (eq car 'define-skeleton)
-			      form
-			    (cdr form)))
-		doc (car form))
-	  (if (stringp doc)
-	      (setq form (cdr form))
-	    (setq doc nil))
-	  (list 'autoload (list 'quote name) file doc
-		(or (eq car 'define-skeleton)
-		    (eq (car-safe (car form)) 'interactive))
-		(if macrop (list 'quote 'macro) nil)))
-      nil)))
-
-(put 'define-skeleton 'doc-string-elt 3)
-
-(defconst generate-autoload-cookie ";;;###autoload"
-  "Magic comment indicating the following form should be autoloaded.
-Used by \\[update-file-autoloads].  This string should be
-meaningless to Lisp (e.g., a comment).
-
-This string is used:
-
-;;;###autoload
-\(defun function-to-be-autoloaded () ...)
-
-If this string appears alone on a line, the following form will be
-read and an autoload made for it.  If there is further text on the line,
-that text will be copied verbatim to `generated-autoload-file'.")
-
-(defconst generate-autoload-section-header "\f\n;;;### "
-  "String inserted before the form identifying
-the section of autoloads for a file.")
-
-(defconst generate-autoload-section-trailer "\n;;;***\n"
-  "String which indicates the end of the section of autoloads for a file.")
-
-;;; Forms which have doc-strings which should be printed specially.
-;;; A doc-string-elt property of ELT says that (nth ELT FORM) is
-;;; the doc-string in FORM.
-;;;
-;;; There used to be the following note here:
-;;; ;;; Note: defconst and defvar should NOT be marked in this way.
-;;; ;;; We don't want to produce defconsts and defvars that
-;;; ;;; make-docfile can grok, because then it would grok them twice,
-;;; ;;; once in foo.el (where they are given with ;;;###autoload) and
-;;; ;;; once in loaddefs.el.
-;;;
-;;; Counter-note: Yes, they should be marked in this way.
-;;; make-docfile only processes those files that are loaded into the
-;;; dumped Emacs, and those files should never have anything
-;;; autoloaded here.  The above-feared problem only occurs with files
-;;; which have autoloaded entries *and* are processed by make-docfile;
-;;; there should be no such files.
-
-(put 'autoload 'doc-string-elt 3)
-(put 'defun    'doc-string-elt 3)
-(put 'defvar   'doc-string-elt 3)
-(put 'defconst 'doc-string-elt 3)
-(put 'defmacro 'doc-string-elt 3)
-
-(defun autoload-trim-file-name (file)
-  ;; Returns a relative pathname of FILE
-  ;; starting from the directory that loaddefs.el is in.
-  ;; That is normally a directory in load-path,
-  ;; which means Emacs will be able to find FILE when it looks.
-  ;; Any extra directory names here would prevent finding the file.
-  (setq file (expand-file-name file))
-  (file-relative-name file
-		      (file-name-directory generated-autoload-file)))
-
-(defun generate-file-autoloads (file)
-  "Insert at point a loaddefs autoload section for FILE.
-autoloads are generated for defuns and defmacros in FILE
-marked by `generate-autoload-cookie' (which see).
-If FILE is being visited in a buffer, the contents of the buffer
-are used."
-  (interactive "fGenerate autoloads for file: ")
-  (let ((outbuf (current-buffer))
-	(autoloads-done '())
-	(load-name (let ((name (file-name-nondirectory file)))
-		     (if (string-match "\\.elc?$" name)
-			 (substring name 0 (match-beginning 0))
-		       name)))
-	(print-length nil)
-	(print-readably t)		; This does something in Lucid Emacs.
-	(float-output-format nil)
-	(done-any nil)
-	(visited (get-file-buffer file))
-	output-end)
-
-    ;; If the autoload section we create here uses an absolute
-    ;; pathname for FILE in its header, and then Emacs is installed
-    ;; under a different path on another system,
-    ;; `update-autoloads-here' won't be able to find the files to be
-    ;; autoloaded.  So, if FILE is in the same directory or a
-    ;; subdirectory of the current buffer's directory, we'll make it
-    ;; relative to the current buffer's directory.
-    (setq file (expand-file-name file))
-    (let* ((source-truename (file-truename file))
-	   (dir-truename (file-name-as-directory
-			  (file-truename default-directory)))
-	   (len (length dir-truename)))
-      (if (and (< len (length source-truename))
-	       (string= dir-truename (substring source-truename 0 len)))
-	  (setq file (substring source-truename len))))
-
-    (message "Generating autoloads for %s..." file)
-    (save-excursion
-      (unwind-protect
-	  (progn
-	    (if visited
-		(set-buffer visited)
-	      ;; It is faster to avoid visiting the file.
-	      (set-buffer (get-buffer-create " *generate-autoload-file*"))
-	      (kill-all-local-variables)
-	      (erase-buffer)
-	      (setq buffer-undo-list t
-		    buffer-read-only nil)
-	      (emacs-lisp-mode)
-	      (insert-file-contents file nil))
-	    (save-excursion
-	      (save-restriction
-		(widen)
-		(goto-char (point-min))
-		(while (not (eobp))
-		  (skip-chars-forward " \t\n\f")
-		  (cond
-		   ((looking-at (regexp-quote generate-autoload-cookie))
-		    (search-forward generate-autoload-cookie)
-		    (skip-chars-forward " \t")
-		    (setq done-any t)
-		    (if (eolp)
-			;; Read the next form and make an autoload.
-			(let* ((form (prog1 (read (current-buffer))
-				       (or (bolp) (forward-line 1))))
-			       (autoload (make-autoload form load-name))
-			       (doc-string-elt (get (car-safe form)
-						    'doc-string-elt)))
-			  (if autoload
-			      (setq autoloads-done (cons (nth 1 form)
-							 autoloads-done))
-			    (setq autoload form))
-			  (if (and doc-string-elt
-				   (stringp (nth doc-string-elt autoload)))
-			      ;; We need to hack the printing because the
-			      ;; doc-string must be printed specially for
-			      ;; make-docfile (sigh).
-			      (let* ((p (nthcdr (1- doc-string-elt)
-						autoload))
-				     (elt (cdr p)))
-				(setcdr p nil)
-				(princ "\n(" outbuf)
-				(let ((print-escape-newlines t))
-				  (mapcar (function (lambda (elt)
-						      (prin1 elt outbuf)
-						      (princ " " outbuf)))
-					  autoload))
-				(princ "\"\\\n" outbuf)
-				(let ((begin (save-excursion
-					       (set-buffer outbuf)
-					       (point))))
-				  (princ (substring
-					  (prin1-to-string (car elt)) 1)
-					 outbuf)
-				  ;; Insert a backslash before each ( that
-				  ;; appears at the beginning of a line in
-				  ;; the doc string.
-				  (save-excursion
-				    (set-buffer outbuf)
-				    (save-excursion
-				      (while (search-backward "\n(" begin t)
-					(forward-char 1)
-					(insert "\\"))))
-				  (if (null (cdr elt))
-				      (princ ")" outbuf)
-				    (princ " " outbuf)
-				    (princ (substring
-					    (prin1-to-string (cdr elt))
-					    1)
-					   outbuf))
-				  (terpri outbuf)))
-			    (let ((print-escape-newlines t))
-			      (print autoload outbuf))))
-			  ;; Copy the rest of the line to the output.
-		      (princ (buffer-substring
-			      (progn
-				;; Back up over whitespace, to preserve it.
-				(skip-chars-backward " \f\t")
-				(if (= (char-after (1+ (point))) ? )
-				    ;; Eat one space.
-				    (forward-char 1))
-				(point))
-			      (progn (forward-line 1) (point)))
-			     outbuf)))
-		   ((looking-at ";")
-		    ;; Don't read the comment.
-		    (forward-line 1))
-		   (t
-		    (forward-sexp 1)
-		    (forward-line 1)))))))
-	(or visited
-	    ;; We created this buffer, so we should kill it.
-	    (kill-buffer (current-buffer)))
-	(set-buffer outbuf)
-	(setq output-end (point-marker))))
-    (if done-any
-	(progn
-	  (insert generate-autoload-section-header)
-	  (prin1 (list 'autoloads autoloads-done load-name
-		       (autoload-trim-file-name file)
-		       (nth 5 (file-attributes file)))
-		 outbuf)
-	  (terpri outbuf)
-	  (insert ";;; Generated autoloads from "
-		  (autoload-trim-file-name file) "\n")
-	  ;; Warn if we put a line in loaddefs.el
-	  ;; that is long enough to cause trouble.
-	  (while (< (point) output-end)
-	    (let ((beg (point)))
-	      (end-of-line)
-	      (if (> (- (point) beg) 900)
-		  (progn
-		    (message "A line is too long--over 900 characters")
-		    (sleep-for 2)
-		    (goto-char output-end))))
-	    (forward-line 1))
-	  (goto-char output-end)
-	  (insert generate-autoload-section-trailer)))
-    (message "Generating autoloads for %s...done" file)))
-
-(defconst generated-autoload-file "loaddefs.el"
-   "*File \\[update-file-autoloads] puts autoloads into.
-A .el file can set this in its local variables section to make its
-autoloads go somewhere else.")
-
-;;;###autoload
-(defun update-file-autoloads (file)
-  "Update the autoloads for FILE in `generated-autoload-file'
-\(which FILE might bind in its local variables)."
-  (interactive "fUpdate autoloads for file: ")
-  (let ((load-name (let ((name (file-name-nondirectory file)))
-		     (if (string-match "\\.elc?$" name)
-			 (substring name 0 (match-beginning 0))
-		       name)))
-	(found nil)
-	(existing-buffer (get-file-buffer file)))
-    (save-excursion
-      ;; We want to get a value for generated-autoload-file from
-      ;; the local variables section if it's there.
-      (if existing-buffer
-	  (set-buffer existing-buffer))
-      (set-buffer (find-file-noselect generated-autoload-file))
-      (save-excursion
-	(save-restriction
-	  (widen)
-	  (goto-char (point-min))
-	  ;; Look for the section for LOAD-NAME.
-	  (while (and (not found)
-		      (search-forward generate-autoload-section-header nil t))
-	    (let ((form (condition-case ()
-			    (read (current-buffer))
-			  (end-of-file nil))))
-	      (cond ((string= (nth 2 form) load-name)
-		     ;; We found the section for this file.
-		     ;; Check if it is up to date.
-		     (let ((begin (match-beginning 0))
-			   (last-time (nth 4 form))
-			   (file-time (nth 5 (file-attributes file))))
-		       (if (and (or (null existing-buffer)
-				    (not (buffer-modified-p existing-buffer)))
-				(listp last-time) (= (length last-time) 2)
-				(or (> (car last-time) (car file-time))
-				    (and (= (car last-time) (car file-time))
-					 (>= (nth 1 last-time)
-					     (nth 1 file-time)))))
-			   (progn
-			     (if (interactive-p)
-				 (message "\
-Autoload section for %s is up to date."
-					  file))
-			     (setq found 'up-to-date))
-			 (search-forward generate-autoload-section-trailer)
-			 (delete-region begin (point))
-			 (setq found t))))
-		    ((string< load-name (nth 2 form))
-		     ;; We've come to a section alphabetically later than
-		     ;; LOAD-NAME.  We assume the file is in order and so
-		     ;; there must be no section for LOAD-NAME.  We will
-		     ;; insert one before the section here.
-		     (goto-char (match-beginning 0))
-		     (setq found 'new)))))
-	  (or found
-	      (progn
-		(setq found 'new)
-		;; No later sections in the file.  Put before the last page.
-		(goto-char (point-max))
-		(search-backward "\f" nil t)))
-	  (or (eq found 'up-to-date)
-	      (and (eq found 'new)
-		   ;; Check that FILE has any cookies before generating a
-		   ;; new section for it.
-		   (save-excursion
-		     (if existing-buffer
-			 (set-buffer existing-buffer)
-		       ;; It is faster to avoid visiting the file.
-		       (set-buffer (get-buffer-create " *autoload-file*"))
-		       (kill-all-local-variables)
-		       (erase-buffer)
-		       (setq buffer-undo-list t
-			     buffer-read-only nil)
-		       (emacs-lisp-mode)
-		       (insert-file-contents file nil))
-		     (save-excursion
-		       (save-restriction
-			 (widen)
-			 (goto-char (point-min))
-			 (prog1
-			     (if (search-forward
-				  (concat "\n" generate-autoload-cookie)
-				  nil t)
-				 nil
-			       (if (interactive-p)
-				   (message "%s has no autoloads" file))
-			       t)
-			   (or existing-buffer
-			       (kill-buffer (current-buffer))))))))
-	      (generate-file-autoloads file))))
-      (if (interactive-p) (save-buffer)))))
-
-;;;###autoload
-(defun update-autoloads-from-directory (dir)
-  "\
-Update loaddefs.el with all the current autoloads from DIR, and no old ones.
-This uses `update-file-autoloads' (which see) do its work."
-  (interactive "DUpdate autoloads from directory: ")
-  (setq dir (expand-file-name dir))
-  (let ((files (directory-files dir nil "^[^=].*\\.el$")))
-    (save-excursion
-      (set-buffer (find-file-noselect
-		   (if (file-exists-p generated-autoload-file)
-		       generated-autoload-file
-		     (expand-file-name generated-autoload-file
-				       dir))))
-      (save-excursion
-	(goto-char (point-min))
-	(while (search-forward generate-autoload-section-header nil t)
-	  (let* ((form (condition-case ()
-			   (read (current-buffer))
-			 (end-of-file nil)))
-		 (file (nth 3 form)))
-	    (cond ((not (stringp file)))
-		  ((not (file-exists-p (expand-file-name file dir)))
-		   ;; Remove the obsolete section.
-		   (let ((begin (match-beginning 0)))
-		     (search-forward generate-autoload-section-trailer)
-		     (delete-region begin (point))))
-		  (t
-		   (update-file-autoloads file)))
-	    (setq files (delete file files)))))
-      ;; Elements remaining in FILES have no existing autoload sections.
-      (mapcar 'update-file-autoloads files)
-      (save-buffer))))
-
-;;;###autoload
-(defun batch-update-autoloads ()
-  "Update loaddefs.el autoloads in batch mode.
-Calls `update-autoloads-from-directory' on each command line argument."
-  (mapcar 'update-autoloads-from-directory command-line-args-left)
-  (setq command-line-args-left nil))
-
-(provide 'autoload)
-
-;;; autoload.el ends here
diff --git a/lisp/emacs-lisp/backquote.el b/lisp/emacs-lisp/backquote.el
deleted file mode 100644
index 807b4bd1c50..00000000000
--- a/lisp/emacs-lisp/backquote.el
+++ /dev/null
@@ -1,212 +0,0 @@
-;;; backquote.el --- implement the ` Lisp construct
-
-;;; Copyright (C) 1990, 1992, 1994 Free Software Foundation, Inc.
-
-;; Author: Rick Sladkey <jrs@world.std.com>
-;; Maintainer: FSF
-;; Keywords: extensions, internal
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This backquote will generate calls to the backquote-list* form.
-;; Both a function version and a macro version are included.
-;; The macro version is used by default because it is faster
-;; and needs no run-time support.  It should really be a subr.
-
-;;; Code:
-
-(provide 'backquote)
-
-;; function and macro versions of backquote-list*
-
-(defun backquote-list*-function (first &rest list)
-  "Like `list' but the last argument is the tail of the new list.
-
-For example (backquote-list* 'a 'b 'c) => (a b . c)"
-  (if list
-      (let* ((rest list) (newlist (cons first nil)) (last newlist))
-	(while (cdr rest)
-	  (setcdr last (cons (car rest) nil))
-	  (setq last (cdr last)
-		rest (cdr rest)))
-	(setcdr last (car rest))
-	newlist)
-    first))
-
-(defmacro backquote-list*-macro (first &rest list)
-  "Like `list' but the last argument is the tail of the new list.
-
-For example (backquote-list* 'a 'b 'c) => (a b . c)"
-  (setq list (reverse (cons first list))
-	first (car list)
-	list (cdr list))
-  (if list
-      (let* ((second (car list))
-	     (rest (cdr list))
-	     (newlist (list 'cons second first)))
-	(while rest
-	  (setq newlist (list 'cons (car rest) newlist)
-		rest (cdr rest)))
-	newlist)
-    first))
-
-(defalias 'backquote-list* (symbol-function 'backquote-list*-macro))
-
-;; A few advertised variables that control which symbols are used
-;; to represent the backquote, unquote, and splice operations.
-
-(defvar backquote-backquote-symbol '\`
-  "*Symbol used to represent a backquote or nested backquote (e.g. `).")
-
-(defvar backquote-unquote-symbol ',
-  "*Symbol used to represent an unquote (e.g. `,') inside a backquote.")
-
-(defvar backquote-splice-symbol ',@
-  "*Symbol used to represent a splice (e.g. `,@') inside a backquote.")
-
-;;;###autoload
-(defmacro backquote (arg)
-  "Argument STRUCTURE describes a template to build.
-
-The whole structure acts as if it were quoted except for certain
-places where expressions are evaluated and inserted or spliced in.
-
-For example:
-
-b              => (ba bb bc)		; assume b has this value
-`(a b c)       => (a b c)		; backquote acts like quote
-`(a ,b c)      => (a (ba bb bc) c)	; insert the value of b
-`(a ,@b c)     => (a ba bb bc c)	; splice in the value of b
-
-Vectors work just like lists.  Nested backquotes are permitted."
-  (cdr (backquote-process arg)))
-
-;; GNU Emacs has no reader macros
-
-;;;###autoload
-(defalias '\` (symbol-function 'backquote))
-
-;; backquote-process returns a dotted-pair of a tag (0, 1, or 2) and
-;; the backquote-processed structure.  0 => the structure is
-;; constant, 1 => to be unquoted, 2 => to be spliced in.
-;; The top-level backquote macro just discards the tag.
-
-(defun backquote-process (s)
-  (cond
-   ((vectorp s)
-    (let ((n (backquote-process (append s ()))))
-      (if (= (car n) 0)
-	  (cons 0 s)
-	(cons 1 (cond
-		 ((eq (nth 1 n) 'list)
-		  (cons 'vector (nthcdr 2 n)))
-		 ((eq (nth 1 n) 'append)
-		  (cons 'vconcat (nthcdr 2 n)))
-		 (t
-		  (list 'apply '(function vector) (cdr n))))))))
-   ((atom s)
-    (cons 0 (if (or (null s) (eq s t) (not (symbolp s)))
-		s
-	      (list 'quote s))))
-   ((eq (car s) backquote-unquote-symbol)
-    (cons 1 (nth 1 s)))
-   ((eq (car s) backquote-splice-symbol)
-    (cons 2 (nth 1 s)))
-   ((eq (car s) backquote-backquote-symbol)
-    (backquote-process (cdr (backquote-process (nth 1 s)))))
-   (t
-    (let ((rest s)
-	  item firstlist list lists expression)
-      ;; Scan this list-level, setting LISTS to a list of forms,
-      ;; each of which produces a list of elements
-      ;; that should go in this level.
-      ;; The order of LISTS is backwards. 
-      ;; If there are non-splicing elements (constant or variable)
-      ;; at the beginning, put them in FIRSTLIST,
-      ;; as a list of tagged values (TAG . FORM).
-      ;; If there are any at the end, they go in LIST, likewise.
-      (while (consp rest)
-	;; Turn . (, foo) into (,@ foo).
-	(if (eq (car rest) backquote-unquote-symbol)
-	    (setq rest (list (list backquote-splice-symbol (nth 1 rest)))))
-	(setq item (backquote-process (car rest)))
-	(cond
-	 ((= (car item) 2)
-	  ;; Put the nonspliced items before the first spliced item
-	  ;; into FIRSTLIST.
-	  (if (null lists)
-	      (setq firstlist list
-		    list nil))
-	  ;; Otherwise, put any preceding nonspliced items into LISTS.
-	  (if list
-	      (setq lists (cons (backquote-listify list '(0 . nil)) lists)))
-	  (setq lists (cons (cdr item) lists))
-	  (setq list nil))
-	 (t
-	  (setq list (cons item list))))
-	(setq rest (cdr rest)))
-      ;; Handle nonsplicing final elements, and the tail of the list
-      ;; (which remains in REST).
-      (if (or rest list)
-	  (setq lists (cons (backquote-listify list (backquote-process rest))
-			    lists)))
-      ;; Turn LISTS into a form that produces the combined list. 
-      (setq expression
-	    (if (or (cdr lists)
-		    (eq (car-safe (car lists)) backquote-splice-symbol))
-		(cons 'append (nreverse lists))
-	      (car lists)))
-      ;; Tack on any initial elements.
-      (if firstlist
-	  (setq expression (backquote-listify firstlist (cons 1 expression))))
-      (if (eq (car-safe expression) 'quote)
-	  (cons 0 (list 'quote s))
-	(cons 1 expression))))))
-
-;; backquote-listify takes (tag . structure) pairs from backquote-process
-;; and decides between append, list, backquote-list*, and cons depending
-;; on which tags are in the list.
-
-(defun backquote-listify (list old-tail)
-  (let ((heads nil) (tail (cdr old-tail)) (list-tail list) (item nil))
-    (if (= (car old-tail) 0)
-	(setq tail (eval tail)
-	      old-tail nil))
-    (while (consp list-tail)
-      (setq item (car list-tail))
-      (setq list-tail (cdr list-tail))
-      (if (or heads old-tail (/= (car item) 0))
-	  (setq heads (cons (cdr item) heads))
-	(setq tail (cons (eval (cdr item)) tail))))
-    (cond
-     (tail
-      (if (null old-tail)
-	  (setq tail (list 'quote tail)))
-      (if heads
-	  (let ((use-list* (or (cdr heads)
-			       (and (consp (car heads))
-				    (eq (car (car heads))
-					backquote-splice-symbol)))))
-	    (cons (if use-list* 'backquote-list* 'cons)
-		  (append heads (list tail))))
-	tail))
-     (t (cons 'list heads)))))
-
-;; backquote.el ends here
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
deleted file mode 100644
index ef2880c7d9b..00000000000
--- a/lisp/emacs-lisp/byte-opt.el
+++ /dev/null
@@ -1,1872 +0,0 @@
-;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler.
-
-;;; Copyright (c) 1991, 1994 Free Software Foundation, Inc.
-
-;; Author: Jamie Zawinski <jwz@lucid.com>
-;;	Hallvard Furuseth <hbf@ulrik.uio.no>
-;; Keywords: internal
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;;; This file has been censored by the Communications Decency Act.
-;;; That law was passed under the guise of a ban on pornography, but
-;;; it bans far more than that.  This file did not contain pornography,
-;;; but it was censored nonetheless.
-
-;;; For information on US government censorship of the Internet, and
-;;; what you can do to bring back freedom of the press, see the web
-;;; site http://www.vtw.org/
-
-;; ========================================================================
-;; "No matter how hard you try, you can't make a racehorse out of a pig.
-;; You can, however, make a faster pig."
-;;
-;; Or, to put it another way, the emacs byte compiler is a VW Bug.  This code
-;; makes it be a VW Bug with fuel injection and a turbocharger...  You're 
-;; still not going to make it go faster than 70 mph, but it might be easier
-;; to get it there.
-;;
-
-;; TO DO:
-;;
-;; (apply '(lambda (x &rest y) ...) 1 (foo))
-;;
-;; maintain a list of functions known not to access any global variables
-;; (actually, give them a 'dynamically-safe property) and then
-;;   (let ( v1 v2 ... vM vN ) <...dynamically-safe...> )  ==>
-;;   (let ( v1 v2 ... vM ) vN <...dynamically-safe...> )
-;; by recursing on this, we might be able to eliminate the entire let.
-;; However certain variables should never have their bindings optimized
-;; away, because they affect everything.
-;;   (put 'debug-on-error 'binding-is-magic t)
-;;   (put 'debug-on-abort 'binding-is-magic t)
-;;   (put 'debug-on-next-call 'binding-is-magic t)
-;;   (put 'mocklisp-arguments 'binding-is-magic t)
-;;   (put 'inhibit-quit 'binding-is-magic t)
-;;   (put 'quit-flag 'binding-is-magic t)
-;;   (put 't 'binding-is-magic t)
-;;   (put 'nil 'binding-is-magic t)
-;; possibly also
-;;   (put 'gc-cons-threshold 'binding-is-magic t)
-;;   (put 'track-mouse 'binding-is-magic t)
-;; others?
-;;
-;; Simple defsubsts often produce forms like
-;;    (let ((v1 (f1)) (v2 (f2)) ...)
-;;       (FN v1 v2 ...))
-;; It would be nice if we could optimize this to 
-;;    (FN (f1) (f2) ...)
-;; but we can't unless FN is dynamically-safe (it might be dynamically
-;; referring to the bindings that the lambda arglist established.)
-;; One of the uncountable lossages introduced by dynamic scope...
-;;
-;; Maybe there should be a control-structure that says "turn on 
-;; fast-and-loose type-assumptive optimizations here."  Then when
-;; we see a form like (car foo) we can from then on assume that
-;; the variable foo is of type cons, and optimize based on that.
-;; But, this won't win much because of (you guessed it) dynamic 
-;; scope.  Anything down the stack could change the value.
-;; (Another reason it doesn't work is that it is perfectly valid
-;; to call car with a null argument.)  A better approach might
-;; be to allow type-specification of the form
-;;   (put 'foo 'arg-types '(float (list integer) dynamic))
-;;   (put 'foo 'result-type 'bool)
-;; It should be possible to have these types checked to a certain
-;; degree.
-;;
-;; collapse common subexpressions
-;;
-;; It would be nice if redundant sequences could be factored out as well,
-;; when they are known to have no side-effects:
-;;   (list (+ a b c) (+ a b c))   -->  a b add c add dup list-2
-;; but beware of traps like
-;;   (cons (list x y) (list x y))
-;;
-;; Tail-recursion elimination is not really possible in Emacs Lisp.
-;; Tail-recursion elimination is almost always impossible when all variables
-;; have dynamic scope, but given that the "return" byteop requires the
-;; binding stack to be empty (rather than emptying it itself), there can be
-;; no truly tail-recursive Emacs Lisp functions that take any arguments or
-;; make any bindings.
-;;
-;; Here is an example of an Emacs Lisp function which could safely be
-;; byte-compiled tail-recursively:
-;;
-;;  (defun tail-map (fn list)
-;;    (cond (list
-;;           (funcall fn (car list))
-;;           (tail-map fn (cdr list)))))
-;;
-;; However, if there was even a single let-binding around the COND,
-;; it could not be byte-compiled, because there would be an "unbind"
-;; byte-op between the final "call" and "return."  Adding a 
-;; Bunbind_all byteop would fix this.
-;;
-;;   (defun foo (x y z) ... (foo a b c))
-;;   ... (const foo) (varref a) (varref b) (varref c) (call 3) END: (return)
-;;   ... (varref a) (varbind x) (varref b) (varbind y) (varref c) (varbind z) (goto 0) END: (unbind-all) (return)
-;;   ... (varref a) (varset x) (varref b) (varset y) (varref c) (varset z) (goto 0) END: (return)
-;;
-;; this also can be considered tail recursion:
-;;
-;;   ... (const foo) (varref a) (call 1) (goto X) ... X: (return)
-;; could generalize this by doing the optimization
-;;   (goto X) ... X: (return)  -->  (return)
-;;
-;; But this doesn't solve all of the problems: although by doing tail-
-;; recursion elimination in this way, the call-stack does not grow, the
-;; binding-stack would grow with each recursive step, and would eventually
-;; overflow.  I don't believe there is any way around this without lexical
-;; scope.
-;;
-;; Wouldn't it be nice if Emacs Lisp had lexical scope.
-;;
-;; Idea: the form (lexical-scope) in a file means that the file may be 
-;; compiled lexically.  This proclamation is file-local.  Then, within 
-;; that file, "let" would establish lexical bindings, and "let-dynamic"
-;; would do things the old way.  (Or we could use CL "declare" forms.)
-;; We'd have to notice defvars and defconsts, since those variables should
-;; always be dynamic, and attempting to do a lexical binding of them
-;; should simply do a dynamic binding instead.
-;; But!  We need to know about variables that were not necessarily defvarred
-;; in the file being compiled (doing a boundp check isn't good enough.)
-;; Fdefvar() would have to be modified to add something to the plist.
-;;
-;; A major disadvantage of this scheme is that the interpreter and compiler 
-;; would have different semantics for files compiled with (dynamic-scope).  
-;; Since this would be a file-local optimization, there would be no way to
-;; modify the interpreter to obey this (unless the loader was hacked 
-;; in some grody way, but that's a really bad idea.)
-
-;; Other things to consider:
-
-;;;;; Associative math should recognize subcalls to identical function:
-;;;(disassemble (lambda (x) (+ (+ (foo) 1) (+ (bar) 2))))
-;;;;; This should generate the same as (1+ x) and (1- x)
-
-;;;(disassemble (lambda (x) (cons (+ x 1) (- x 1))))
-;;;;; An awful lot of functions always return a non-nil value.  If they're
-;;;;; error free also they may act as true-constants.
-
-;;;(disassemble (lambda (x) (and (point) (foo))))
-;;;;; When 
-;;;;;   - all but one arguments to a function are constant
-;;;;;   - the non-constant argument is an if-expression (cond-expression?)
-;;;;; then the outer function can be distributed.  If the guarding
-;;;;; condition is side-effect-free [assignment-free] then the other
-;;;;; arguments may be any expressions.  Since, however, the code size
-;;;;; can increase this way they should be "simple".  Compare:
-
-;;;(disassemble (lambda (x) (eq (if (point) 'a 'b) 'c)))
-;;;(disassemble (lambda (x) (if (point) (eq 'a 'c) (eq 'b 'c))))
-
-;;;;; (car (cons A B)) -> (progn B A)
-;;;(disassemble (lambda (x) (car (cons (foo) 42))))
-
-;;;;; (cdr (cons A B)) -> (progn A B)
-;;;(disassemble (lambda (x) (cdr (cons 42 (foo)))))
-
-;;;;; (car (list A B ...)) -> (progn B ... A)
-;;;(disassemble (lambda (x) (car (list (foo) 42 (bar)))))
-
-;;;;; (cdr (list A B ...)) -> (progn A (list B ...))
-;;;(disassemble (lambda (x) (cdr (list 42 (foo) (bar)))))
-
-
-;;; Code:
-
-(defun byte-compile-log-lap-1 (format &rest args)
-  (if (aref byte-code-vector 0)
-      (error "The old version of the disassembler is loaded.  Reload new-bytecomp as well."))
-  (byte-compile-log-1
-   (apply 'format format
-     (let (c a)
-       (mapcar '(lambda (arg)
-		  (if (not (consp arg))
-		      (if (and (symbolp arg)
-			       (string-match "^byte-" (symbol-name arg)))
-			  (intern (substring (symbol-name arg) 5))
-			arg)
-		    (if (integerp (setq c (car arg)))
-			(error "non-symbolic byte-op %s" c))
-		    (if (eq c 'TAG)
-			(setq c arg)
-		      (setq a (cond ((memq c byte-goto-ops)
-				     (car (cdr (cdr arg))))
-				    ((memq c byte-constref-ops)
-				     (car (cdr arg)))
-				    (t (cdr arg))))
-		      (setq c (symbol-name c))
-		      (if (string-match "^byte-." c)
-			  (setq c (intern (substring c 5)))))
-		    (if (eq c 'constant) (setq c 'const))
-		    (if (and (eq (cdr arg) 0)
-			     (not (memq c '(unbind call const))))
-			c
-		      (format "(%s %s)" c a))))
-	       args)))))
-
-(defmacro byte-compile-log-lap (format-string &rest args)
-  (list 'and
-	'(memq byte-optimize-log '(t byte))
-	(cons 'byte-compile-log-lap-1
-	      (cons format-string args))))
-
-
-;;; byte-compile optimizers to support inlining
-
-(put 'inline 'byte-optimizer 'byte-optimize-inline-handler)
-
-(defun byte-optimize-inline-handler (form)
-  "byte-optimize-handler for the `inline' special-form."
-  (cons 'progn
-	(mapcar
-	 '(lambda (sexp)
-	    (let ((fn (car-safe sexp)))
-	      (if (and (symbolp fn)
-		    (or (cdr (assq fn byte-compile-function-environment))
-		      (and (fboundp fn)
-			(not (or (cdr (assq fn byte-compile-macro-environment))
-				 (and (consp (setq fn (symbol-function fn)))
-				      (eq (car fn) 'macro))
-				 (subrp fn))))))
-		  (byte-compile-inline-expand sexp)
-		sexp)))
-	 (cdr form))))
-
-
-;; Splice the given lap code into the current instruction stream.
-;; If it has any labels in it, you're responsible for making sure there
-;; are no collisions, and that byte-compile-tag-number is reasonable
-;; after this is spliced in.  The provided list is destroyed.
-(defun byte-inline-lapcode (lap)
-  (setq byte-compile-output (nconc (nreverse lap) byte-compile-output)))
-
-
-(defun byte-compile-inline-expand (form)
-  (let* ((name (car form))
-	 (fn (or (cdr (assq name byte-compile-function-environment))
-		 (and (fboundp name) (symbol-function name)))))
-    (if (null fn)
-	(progn
-	  (byte-compile-warn "attempt to inline %s before it was defined" name)
-	  form)
-      ;; else
-      (if (and (consp fn) (eq (car fn) 'autoload))
-	  (load (nth 1 fn)))
-      (if (and (consp fn) (eq (car fn) 'autoload))
-	  (error "file \"%s\" didn't define \"%s\"" (nth 1 fn) name))
-      (if (symbolp fn)
-	  (byte-compile-inline-expand (cons fn (cdr form)))
-	(if (byte-code-function-p fn)
-	    (progn
-	      (fetch-bytecode fn)
-	      (cons (list 'lambda (aref fn 0)
-			  (list 'byte-code (aref fn 1) (aref fn 2) (aref fn 3)))
-		    (cdr form)))
-	  (if (not (eq (car fn) 'lambda)) (error "%s is not a lambda" name))
-	  (cons fn (cdr form)))))))
-
-;;; ((lambda ...) ...)
-;;; 
-(defun byte-compile-unfold-lambda (form &optional name)
-  (or name (setq name "anonymous lambda"))
-  (let ((lambda (car form))
-	(values (cdr form)))
-    (if (byte-code-function-p lambda)
-	(setq lambda (list 'lambda (aref lambda 0)
-			   (list 'byte-code (aref lambda 1)
-				 (aref lambda 2) (aref lambda 3)))))
-    (let ((arglist (nth 1 lambda))
-	  (body (cdr (cdr lambda)))
-	  optionalp restp
-	  bindings)
-      (if (and (stringp (car body)) (cdr body))
-	  (setq body (cdr body)))
-      (if (and (consp (car body)) (eq 'interactive (car (car body))))
-	  (setq body (cdr body)))
-      (while arglist
-	(cond ((eq (car arglist) '&optional)
-	       ;; ok, I'll let this slide because funcall_lambda() does...
-	       ;; (if optionalp (error "multiple &optional keywords in %s" name))
-	       (if restp (error "&optional found after &rest in %s" name))
-	       (if (null (cdr arglist))
-		   (error "nothing after &optional in %s" name))
-	       (setq optionalp t))
-	      ((eq (car arglist) '&rest)
-	       ;; ...but it is by no stretch of the imagination a reasonable
-	       ;; thing that funcall_lambda() allows (&rest x y) and
-	       ;; (&rest x &optional y) in arglists.
-	       (if (null (cdr arglist))
-		   (error "nothing after &rest in %s" name))
-	       (if (cdr (cdr arglist))
-		   (error "multiple vars after &rest in %s" name))
-	       (setq restp t))
-	      (restp
-	       (setq bindings (cons (list (car arglist)
-					  (and values (cons 'list values)))
-				    bindings)
-		     values nil))
-	      ((and (not optionalp) (null values))
-	       (byte-compile-warn "attempt to open-code %s with too few arguments" name)
-	       (setq arglist nil values 'too-few))
-	      (t
-	       (setq bindings (cons (list (car arglist) (car values))
-				    bindings)
-		     values (cdr values))))
-	(setq arglist (cdr arglist)))
-      (if values
-	  (progn
-	    (or (eq values 'too-few)
-		(byte-compile-warn
-		 "attempt to open-code %s with too many arguments" name))
-	    form)
-	(setq body (mapcar 'byte-optimize-form body))
-	(let ((newform 
-	       (if bindings
-		   (cons 'let (cons (nreverse bindings) body))
-		 (cons 'progn body))))
-	  (byte-compile-log "  %s\t==>\t%s" form newform)
-	  newform)))))
-
-
-;;; implementing source-level optimizers
-
-(defun byte-optimize-form-code-walker (form for-effect)
-  ;;
-  ;; For normal function calls, We can just mapcar the optimizer the cdr.  But
-  ;; we need to have special knowledge of the syntax of the special forms
-  ;; like let and defun (that's why they're special forms :-).  (Actually,
-  ;; the important aspect is that they are subrs that don't evaluate all of
-  ;; their args.)
-  ;;
-  (let ((fn (car-safe form))
-	tmp)
-    (cond ((not (consp form))
-	   (if (not (and for-effect
-			 (or byte-compile-delete-errors
-			     (not (symbolp form))
-			     (eq form t))))
-	     form))
-	  ((eq fn 'quote)
-	   (if (cdr (cdr form))
-	       (byte-compile-warn "malformed quote form: %s"
-				  (prin1-to-string form)))
-	   ;; map (quote nil) to nil to simplify optimizer logic.
-	   ;; map quoted constants to nil if for-effect (just because).
-	   (and (nth 1 form)
-		(not for-effect)
-		form))
-	  ((or (byte-code-function-p fn)
-	       (eq 'lambda (car-safe fn)))
-	   (byte-compile-unfold-lambda form))
-	  ((memq fn '(let let*))
-	   ;; recursively enter the optimizer for the bindings and body
-	   ;; of a let or let*.  This for depth-firstness: forms that
-	   ;; are more deeply nested are optimized first.
-	   (cons fn
-	     (cons
-	      (mapcar '(lambda (binding)
-			 (if (symbolp binding)
-			     binding
-			   (if (cdr (cdr binding))
-			       (byte-compile-warn "malformed let binding: %s"
-						  (prin1-to-string binding)))
-			   (list (car binding)
-				 (byte-optimize-form (nth 1 binding) nil))))
-		      (nth 1 form))
-	      (byte-optimize-body (cdr (cdr form)) for-effect))))
-	  ((eq fn 'cond)
-	   (cons fn
-		 (mapcar '(lambda (clause)
-			    (if (consp clause)
-				(cons
-				 (byte-optimize-form (car clause) nil)
-				 (byte-optimize-body (cdr clause) for-effect))
-			      (byte-compile-warn "malformed cond form: %s"
-						 (prin1-to-string clause))
-			      clause))
-			 (cdr form))))
-	  ((eq fn 'progn)
-	   ;; as an extra added bonus, this simplifies (progn <x>) --> <x>
-	   (if (cdr (cdr form))
-	       (progn
-		 (setq tmp (byte-optimize-body (cdr form) for-effect))
-		 (if (cdr tmp) (cons 'progn tmp) (car tmp)))
-	     (byte-optimize-form (nth 1 form) for-effect)))
-	  ((eq fn 'prog1)
-	   (if (cdr (cdr form))
-	       (cons 'prog1
-		     (cons (byte-optimize-form (nth 1 form) for-effect)
-			   (byte-optimize-body (cdr (cdr form)) t)))
-	     (byte-optimize-form (nth 1 form) for-effect)))
-	  ((eq fn 'prog2)
-	   (cons 'prog2
-	     (cons (byte-optimize-form (nth 1 form) t)
-	       (cons (byte-optimize-form (nth 2 form) for-effect)
-		     (byte-optimize-body (cdr (cdr (cdr form))) t)))))
-	  
-	  ((memq fn '(save-excursion save-restriction save-current-buffer))
-	   ;; those subrs which have an implicit progn; it's not quite good
-	   ;; enough to treat these like normal function calls.
-	   ;; This can turn (save-excursion ...) into (save-excursion) which
-	   ;; will be optimized away in the lap-optimize pass.
-	   (cons fn (byte-optimize-body (cdr form) for-effect)))
-	  
-	  ((eq fn 'with-output-to-temp-buffer)
-	   ;; this is just like the above, except for the first argument.
-	   (cons fn
-	     (cons
-	      (byte-optimize-form (nth 1 form) nil)
-	      (byte-optimize-body (cdr (cdr form)) for-effect))))
-	  
-	  ((eq fn 'if)
-	   (cons fn
-	     (cons (byte-optimize-form (nth 1 form) nil)
-	       (cons
-		(byte-optimize-form (nth 2 form) for-effect)
-		(byte-optimize-body (nthcdr 3 form) for-effect)))))
-	  
-	  ((memq fn '(and or))  ; remember, and/or are control structures.
-	   ;; take forms off the back until we can't any more.
-	   ;; In the future it could conceivably be a problem that the
-	   ;; subexpressions of these forms are optimized in the reverse
-	   ;; order, but it's ok for now.
-	   (if for-effect
-	       (let ((backwards (reverse (cdr form))))
-		 (while (and backwards
-			     (null (setcar backwards
-					   (byte-optimize-form (car backwards)
-							       for-effect))))
-		   (setq backwards (cdr backwards)))
-		 (if (and (cdr form) (null backwards))
-		     (byte-compile-log
-		      "  all subforms of %s called for effect; deleted" form))
-		 (and backwards
-		      (cons fn (nreverse backwards))))
-	     (cons fn (mapcar 'byte-optimize-form (cdr form)))))
-
-	  ((eq fn 'interactive)
-	   (byte-compile-warn "misplaced interactive spec: %s"
-			      (prin1-to-string form))
-	   nil)
-	  
-	  ((memq fn '(defun defmacro function
-		      condition-case save-window-excursion))
-	   ;; These forms are compiled as constants or by breaking out
-	   ;; all the subexpressions and compiling them separately.
-	   form)
-
-	  ((eq fn 'unwind-protect)
-	   ;; the "protected" part of an unwind-protect is compiled (and thus
-	   ;; optimized) as a top-level form, so don't do it here.  But the
-	   ;; non-protected part has the same for-effect status as the
-	   ;; unwind-protect itself.  (The protected part is always for effect,
-	   ;; but that isn't handled properly yet.)
-	   (cons fn
-		 (cons (byte-optimize-form (nth 1 form) for-effect)
-		       (cdr (cdr form)))))
-	   
-	  ((eq fn 'catch)
-	   ;; the body of a catch is compiled (and thus optimized) as a
-	   ;; top-level form, so don't do it here.  The tag is never
-	   ;; for-effect.  The body should have the same for-effect status
-	   ;; as the catch form itself, but that isn't handled properly yet.
-	   (cons fn
-		 (cons (byte-optimize-form (nth 1 form) nil)
-		       (cdr (cdr form)))))
-
-	  ;; If optimization is on, this is the only place that macros are
-	  ;; expanded.  If optimization is off, then macroexpansion happens
-	  ;; in byte-compile-form.  Otherwise, the macros are already expanded
-	  ;; by the time that is reached.
-	  ((not (eq form
-		    (setq form (macroexpand form
-					    byte-compile-macro-environment))))
-	   (byte-optimize-form form for-effect))
-	  
-	  ((not (symbolp fn))
-	   (or (eq 'mocklisp (car-safe fn)) ; ha!
-	       (byte-compile-warn "%s is a malformed function"
-				  (prin1-to-string fn)))
-	   form)
-
-	  ((and for-effect (setq tmp (get fn 'side-effect-free))
-		(or byte-compile-delete-errors
-		    (eq tmp 'error-free)
-		    (progn
-		      (byte-compile-warn "%s called for effect"
-					 (prin1-to-string form))
-		      nil)))
-	   (byte-compile-log "  %s called for effect; deleted" fn)
-	   ;; appending a nil here might not be necessary, but it can't hurt.
-	   (byte-optimize-form
-	    (cons 'progn (append (cdr form) '(nil))) t))
-	  
-	  (t
-	   ;; Otherwise, no args can be considered to be for-effect,
-	   ;; even if the called function is for-effect, because we
-	   ;; don't know anything about that function.
-	   (cons fn (mapcar 'byte-optimize-form (cdr form)))))))
-
-
-(defun byte-optimize-form (form &optional for-effect)
-  "The source-level pass of the optimizer."
-  ;;
-  ;; First, optimize all sub-forms of this one.
-  (setq form (byte-optimize-form-code-walker form for-effect))
-  ;;
-  ;; after optimizing all subforms, optimize this form until it doesn't
-  ;; optimize any further.  This means that some forms will be passed through
-  ;; the optimizer many times, but that's necessary to make the for-effect
-  ;; processing do as much as possible.
-  ;;
-  (let (opt new)
-    (if (and (consp form)
-	     (symbolp (car form))
-	     (or (and for-effect
-		      ;; we don't have any of these yet, but we might.
-		      (setq opt (get (car form) 'byte-for-effect-optimizer)))
-		 (setq opt (get (car form) 'byte-optimizer)))
-	     (not (eq form (setq new (funcall opt form)))))
-	(progn
-;;	  (if (equal form new) (error "bogus optimizer -- %s" opt))
-	  (byte-compile-log "  %s\t==>\t%s" form new)
-	  (setq new (byte-optimize-form new for-effect))
-	  new)
-      form)))
-
-
-(defun byte-optimize-body (forms all-for-effect)
-  ;; optimize the cdr of a progn or implicit progn; all forms is a list of
-  ;; forms, all but the last of which are optimized with the assumption that
-  ;; they are being called for effect.  the last is for-effect as well if
-  ;; all-for-effect is true.  returns a new list of forms.
-  (let ((rest forms)
-	(result nil)
-	fe new)
-    (while rest
-      (setq fe (or all-for-effect (cdr rest)))
-      (setq new (and (car rest) (byte-optimize-form (car rest) fe)))
-      (if (or new (not fe))
-	  (setq result (cons new result)))
-      (setq rest (cdr rest)))
-    (nreverse result)))
-
-
-;;; some source-level optimizers
-;;;
-;;; when writing optimizers, be VERY careful that the optimizer returns
-;;; something not EQ to its argument if and ONLY if it has made a change.
-;;; This implies that you cannot simply destructively modify the list;
-;;; you must return something not EQ to it if you make an optimization.
-;;;
-;;; It is now safe to optimize code such that it introduces new bindings.
-
-;; I'd like this to be a defsubst, but let's not be self-referential...
-(defmacro byte-compile-trueconstp (form)
-  ;; Returns non-nil if FORM is a non-nil constant.
-  (` (cond ((consp (, form)) (eq (car (, form)) 'quote))
-	   ((not (symbolp (, form))))
-	   ((eq (, form) t)))))
-
-;; If the function is being called with constant numeric args,
-;; evaluate as much as possible at compile-time.  This optimizer 
-;; assumes that the function is associative, like + or *.
-(defun byte-optimize-associative-math (form)
-  (let ((args nil)
-	(constants nil)
-	(rest (cdr form)))
-    (while rest
-      (if (numberp (car rest))
-	  (setq constants (cons (car rest) constants))
-	  (setq args (cons (car rest) args)))
-      (setq rest (cdr rest)))
-    (if (cdr constants)
-	(if args
-	    (list (car form)
-		  (apply (car form) constants)
-		  (if (cdr args)
-		      (cons (car form) (nreverse args))
-		      (car args)))
-	    (apply (car form) constants))
-	form)))
-
-;; If the function is being called with constant numeric args,
-;; evaluate as much as possible at compile-time.  This optimizer
-;; assumes that the function satisfies
-;;   (op x1 x2 ... xn) == (op ...(op (op x1 x2) x3) ...xn)
-;; like - and /.
-(defun byte-optimize-nonassociative-math (form)
-  (if (or (not (numberp (car (cdr form))))
-	  (not (numberp (car (cdr (cdr form))))))
-      form
-    (let ((constant (car (cdr form)))
-	  (rest (cdr (cdr form))))
-      (while (numberp (car rest))
-	(setq constant (funcall (car form) constant (car rest))
-	      rest (cdr rest)))
-      (if rest
-	  (cons (car form) (cons constant rest))
-	  constant))))
-
-;;(defun byte-optimize-associative-two-args-math (form)
-;;  (setq form (byte-optimize-associative-math form))
-;;  (if (consp form)
-;;      (byte-optimize-two-args-left form)
-;;      form))
-
-;;(defun byte-optimize-nonassociative-two-args-math (form)
-;;  (setq form (byte-optimize-nonassociative-math form))
-;;  (if (consp form)
-;;      (byte-optimize-two-args-right form)
-;;      form))
-
-(defun byte-optimize-approx-equal (x y)
-  (< (* (abs (- x y)) 100) (abs (+ x y))))
-
-;; Collect all the constants from FORM, after the STARTth arg,
-;; and apply FUN to them to make one argument at the end.
-;; For functions that can handle floats, that optimization
-;; can be incorrect because reordering can cause an overflow
-;; that would otherwise be avoided by encountering an arg that is a float.
-;; We avoid this problem by (1) not moving float constants and
-;; (2) not moving anything if it would cause an overflow.
-(defun byte-optimize-delay-constants-math (form start fun)
-  ;; Merge all FORM's constants from number START, call FUN on them
-  ;; and put the result at the end.
-  (let ((rest (nthcdr (1- start) form))
-	(orig form)
-	;; t means we must check for overflow.
-	(overflow (memq fun '(+ *))))
-    (while (cdr (setq rest (cdr rest)))
-      (if (integerp (car rest))
-	  (let (constants)
-	    (setq form (copy-sequence form)
-		  rest (nthcdr (1- start) form))
-	    (while (setq rest (cdr rest))
-	      (cond ((integerp (car rest))
-		     (setq constants (cons (car rest) constants))
-		     (setcar rest nil))))
-	    ;; If necessary, check now for overflow
-	    ;; that might be caused by reordering.
-	    (if (and overflow
-		     ;; We have overflow if the result of doing the arithmetic
-		     ;; on floats is not even close to the result
-		     ;; of doing it on integers.
-		     (not (byte-optimize-approx-equal
-			    (apply fun (mapcar 'float constants))
-			    (float (apply fun constants)))))
-		(setq form orig)
-	      (setq form (nconc (delq nil form)
-				(list (apply fun (nreverse constants)))))))))
-    form))
-
-(defun byte-optimize-plus (form)
-  (setq form (byte-optimize-delay-constants-math form 1 '+))
-  (if (memq 0 form) (setq form (delq 0 (copy-sequence form))))
-  ;;(setq form (byte-optimize-associative-two-args-math form))
-  (cond ((null (cdr form))
-	 (condition-case ()
-	     (eval form)
-	   (error form)))
-;;; It is not safe to delete the function entirely
-;;; (actually, it would be safe if we know the sole arg
-;;; is not a marker).
-;;	((null (cdr (cdr form))) (nth 1 form))
-	(t form)))
-
-(defun byte-optimize-minus (form)
-  ;; Put constants at the end, except the last constant.
-  (setq form (byte-optimize-delay-constants-math form 2 '+))
-  ;; Now only first and last element can be a number.
-  (let ((last (car (reverse (nthcdr 3 form)))))
-    (cond ((eq 0 last)
-	   ;; (- x y ... 0)  --> (- x y ...)
-	   (setq form (copy-sequence form))
-	   (setcdr (cdr (cdr form)) (delq 0 (nthcdr 3 form))))
-	  ;; If form is (- CONST foo... CONST), merge first and last.
-	  ((and (numberp (nth 1 form))
-		(numberp last))
-	   (setq form (nconc (list '- (- (nth 1 form) last) (nth 2 form))
-			     (delq last (copy-sequence (nthcdr 3 form))))))))
-;;; It is not safe to delete the function entirely
-;;; (actually, it would be safe if we know the sole arg
-;;; is not a marker).
-;;;  (if (eq (nth 2 form) 0)
-;;;      (nth 1 form)			; (- x 0)  -->  x
-    (byte-optimize-predicate
-     (if (and (null (cdr (cdr (cdr form))))
-	      (eq (nth 1 form) 0))	; (- 0 x)  -->  (- x)
-	 (cons (car form) (cdr (cdr form)))
-       form))
-;;;    )
-  )
-
-(defun byte-optimize-multiply (form)
-  (setq form (byte-optimize-delay-constants-math form 1 '*))
-  ;; If there is a constant in FORM, it is now the last element.
-  (cond ((null (cdr form)) 1)
-;;; It is not safe to delete the function entirely
-;;; (actually, it would be safe if we know the sole arg
-;;; is not a marker or if it appears in other arithmetic).
-;;;	((null (cdr (cdr form))) (nth 1 form))
-	((let ((last (car (reverse form))))
-	   (cond ((eq 0 last)  (cons 'progn (cdr form)))
-		 ((eq 1 last)  (delq 1 (copy-sequence form)))
-		 ((eq -1 last) (list '- (delq -1 (copy-sequence form))))
-		 ((and (eq 2 last)
-		       (memq t (mapcar 'symbolp (cdr form))))
-		  (prog1 (setq form (delq 2 (copy-sequence form)))
-		    (while (not (symbolp (car (setq form (cdr form))))))
-		    (setcar form (list '+ (car form) (car form)))))
-		 (form))))))
-
-(defsubst byte-compile-butlast (form)
-  (nreverse (cdr (reverse form))))
-
-(defun byte-optimize-divide (form)
-  (setq form (byte-optimize-delay-constants-math form 2 '*))
-  (let ((last (car (reverse (cdr (cdr form))))))
-    (if (numberp last)
-	(cond ((= (length form) 3)
-	       (if (and (numberp (nth 1 form))
-			(not (zerop last))
-			(condition-case nil
-			    (/ (nth 1 form) last)
-			  (error nil)))
-		   (setq form (list 'progn (/ (nth 1 form) last)))))
-	      ((= last 1)
-	       (setq form (byte-compile-butlast form)))
-	      ((numberp (nth 1 form))
-	       (setq form (cons (car form)
-				(cons (/ (nth 1 form) last)
-				      (byte-compile-butlast (cdr (cdr form)))))
-		     last nil))))
-    (cond 
-;;;	  ((null (cdr (cdr form)))
-;;;	   (nth 1 form))
-	  ((eq (nth 1 form) 0)
-	   (append '(progn) (cdr (cdr form)) '(0)))
-	  ((eq last -1)
-	   (list '- (if (nthcdr 3 form)
-			(byte-compile-butlast form)
-		      (nth 1 form))))
-	  (form))))
-
-(defun byte-optimize-logmumble (form)
-  (setq form (byte-optimize-delay-constants-math form 1 (car form)))
-  (byte-optimize-predicate
-   (cond ((memq 0 form)
-	  (setq form (if (eq (car form) 'logand)
-			 (cons 'progn (cdr form))
-		       (delq 0 (copy-sequence form)))))
-	 ((and (eq (car-safe form) 'logior)
-	       (memq -1 form))
-	  (cons 'progn (cdr form)))
-	 (form))))
-
-
-(defun byte-optimize-binary-predicate (form)
-  (if (byte-compile-constp (nth 1 form))
-      (if (byte-compile-constp (nth 2 form))
-	  (condition-case ()
-	      (list 'quote (eval form))
-	    (error form))
-	;; This can enable some lapcode optimizations.
-	(list (car form) (nth 2 form) (nth 1 form)))
-    form))
-
-(defun byte-optimize-predicate (form)
-  (let ((ok t)
-	(rest (cdr form)))
-    (while (and rest ok)
-      (setq ok (byte-compile-constp (car rest))
-	    rest (cdr rest)))
-    (if ok
-	(condition-case ()
-	    (list 'quote (eval form))
-	  (error form))
-	form)))
-
-(defun byte-optimize-identity (form)
-  (if (and (cdr form) (null (cdr (cdr form))))
-      (nth 1 form)
-    (byte-compile-warn "identity called with %d arg%s, but requires 1"
-		       (length (cdr form))
-		       (if (= 1 (length (cdr form))) "" "s"))
-    form))
-
-(put 'identity 'byte-optimizer 'byte-optimize-identity)
-
-(put '+   'byte-optimizer 'byte-optimize-plus)
-(put '*   'byte-optimizer 'byte-optimize-multiply)
-(put '-   'byte-optimizer 'byte-optimize-minus)
-(put '/   'byte-optimizer 'byte-optimize-divide)
-(put 'max 'byte-optimizer 'byte-optimize-associative-math)
-(put 'min 'byte-optimizer 'byte-optimize-associative-math)
-
-(put '=   'byte-optimizer 'byte-optimize-binary-predicate)
-(put 'eq  'byte-optimizer 'byte-optimize-binary-predicate)
-(put 'eql 'byte-optimizer 'byte-optimize-binary-predicate)
-(put 'equal   'byte-optimizer 'byte-optimize-binary-predicate)
-(put 'string= 'byte-optimizer 'byte-optimize-binary-predicate)
-(put 'string-equal 'byte-optimizer 'byte-optimize-binary-predicate)
-
-(put '<   'byte-optimizer 'byte-optimize-predicate)
-(put '>   'byte-optimizer 'byte-optimize-predicate)
-(put '<=  'byte-optimizer 'byte-optimize-predicate)
-(put '>=  'byte-optimizer 'byte-optimize-predicate)
-(put '1+  'byte-optimizer 'byte-optimize-predicate)
-(put '1-  'byte-optimizer 'byte-optimize-predicate)
-(put 'not 'byte-optimizer 'byte-optimize-predicate)
-(put 'null  'byte-optimizer 'byte-optimize-predicate)
-(put 'memq  'byte-optimizer 'byte-optimize-predicate)
-(put 'consp 'byte-optimizer 'byte-optimize-predicate)
-(put 'listp 'byte-optimizer 'byte-optimize-predicate)
-(put 'symbolp 'byte-optimizer 'byte-optimize-predicate)
-(put 'stringp 'byte-optimizer 'byte-optimize-predicate)
-(put 'string< 'byte-optimizer 'byte-optimize-predicate)
-(put 'string-lessp 'byte-optimizer 'byte-optimize-predicate)
-
-(put 'logand 'byte-optimizer 'byte-optimize-logmumble)
-(put 'logior 'byte-optimizer 'byte-optimize-logmumble)
-(put 'logxor 'byte-optimizer 'byte-optimize-logmumble)
-(put 'lognot 'byte-optimizer 'byte-optimize-predicate)
-
-(put 'car 'byte-optimizer 'byte-optimize-predicate)
-(put 'cdr 'byte-optimizer 'byte-optimize-predicate)
-(put 'car-safe 'byte-optimizer 'byte-optimize-predicate)
-(put 'cdr-safe 'byte-optimizer 'byte-optimize-predicate)
-
-
-;; I'm not convinced that this is necessary.  Doesn't the optimizer loop 
-;; take care of this? - Jamie
-;; I think this may some times be necessary to reduce ie (quote 5) to 5,
-;; so arithmetic optimizers recognize the numeric constant.  - Hallvard
-(put 'quote 'byte-optimizer 'byte-optimize-quote)
-(defun byte-optimize-quote (form)
-  (if (or (consp (nth 1 form))
-	  (and (symbolp (nth 1 form))
-	       (not (memq (nth 1 form) '(nil t)))))
-      form
-    (nth 1 form)))
-
-(defun byte-optimize-zerop (form)
-  (cond ((numberp (nth 1 form))
-	 (eval form))
-	(byte-compile-delete-errors
-	 (list '= (nth 1 form) 0))
-	(form)))
-
-(put 'zerop 'byte-optimizer 'byte-optimize-zerop)
-
-(defun byte-optimize-and (form)
-  ;; Simplify if less than 2 args.
-  ;; if there is a literal nil in the args to `and', throw it and following
-  ;; forms away, and surround the `and' with (progn ... nil).
-  (cond ((null (cdr form)))
-	((memq nil form)
-	 (list 'progn
-	       (byte-optimize-and
-		(prog1 (setq form (copy-sequence form))
-		  (while (nth 1 form)
-		    (setq form (cdr form)))
-		  (setcdr form nil)))
-	       nil))
-	((null (cdr (cdr form)))
-	 (nth 1 form))
-	((byte-optimize-predicate form))))
-
-(defun byte-optimize-or (form)
-  ;; Throw away nil's, and simplify if less than 2 args.
-  ;; If there is a literal non-nil constant in the args to `or', throw away all
-  ;; following forms.
-  (if (memq nil form)
-      (setq form (delq nil (copy-sequence form))))
-  (let ((rest form))
-    (while (cdr (setq rest (cdr rest)))
-      (if (byte-compile-trueconstp (car rest))
-	  (setq form (copy-sequence form)
-		rest (setcdr (memq (car rest) form) nil))))
-    (if (cdr (cdr form))
-	(byte-optimize-predicate form)
-      (nth 1 form))))
-
-(defun byte-optimize-cond (form)
-  ;; if any clauses have a literal nil as their test, throw them away.
-  ;; if any clause has a literal non-nil constant as its test, throw
-  ;; away all following clauses.
-  (let (rest)
-    ;; This must be first, to reduce (cond (t ...) (nil)) to (progn t ...)
-    (while (setq rest (assq nil (cdr form)))
-      (setq form (delq rest (copy-sequence form))))
-    (if (memq nil (cdr form))
-	(setq form (delq nil (copy-sequence form))))
-    (setq rest form)
-    (while (setq rest (cdr rest))
-      (cond ((byte-compile-trueconstp (car-safe (car rest)))
-	     (cond ((eq rest (cdr form))
-		    (setq form
-			  (if (cdr (car rest))
-			      (if (cdr (cdr (car rest)))
-				  (cons 'progn (cdr (car rest)))
-				(nth 1 (car rest)))
-			    (car (car rest)))))
-		   ((cdr rest)
-		    (setq form (copy-sequence form))
-		    (setcdr (memq (car rest) form) nil)))
-	     (setq rest nil)))))
-  ;;
-  ;; Turn (cond (( <x> )) ... ) into (or <x> (cond ... ))
-  (if (eq 'cond (car-safe form))
-      (let ((clauses (cdr form)))
-	(if (and (consp (car clauses))
-		 (null (cdr (car clauses))))
-	    (list 'or (car (car clauses))
-		  (byte-optimize-cond
-		   (cons (car form) (cdr (cdr form)))))
-	  form))
-    form))
-
-(defun byte-optimize-if (form)
-  ;; (if <true-constant> <then> <else...>) ==> <then>
-  ;; (if <false-constant> <then> <else...>) ==> (progn <else...>)
-  ;; (if <test> nil <else...>) ==> (if (not <test>) (progn <else...>))
-  ;; (if <test> <then> nil) ==> (if <test> <then>)
-  (let ((clause (nth 1 form)))
-    (cond ((byte-compile-trueconstp clause)
-	   (nth 2 form))
-	  ((null clause)
-	   (if (nthcdr 4 form)
-	       (cons 'progn (nthcdr 3 form))
-	     (nth 3 form)))
-	  ((nth 2 form)
-	   (if (equal '(nil) (nthcdr 3 form))
-	       (list 'if clause (nth 2 form))
-	     form))
-	  ((or (nth 3 form) (nthcdr 4 form))
-	   (list 'if
-		 ;; Don't make a double negative;
-		 ;; instead, take away the one that is there.
-		 (if (and (consp clause) (memq (car clause) '(not null))
-			  (= (length clause) 2)) ; (not xxxx) or (not (xxxx))
-		     (nth 1 clause)
-		   (list 'not clause))
-		 (if (nthcdr 4 form)
-		     (cons 'progn (nthcdr 3 form))
-		   (nth 3 form))))
-	  (t
-	   (list 'progn clause nil)))))
-
-(defun byte-optimize-while (form)
-  (if (nth 1 form)
-      form))
-
-(put 'and   'byte-optimizer 'byte-optimize-and)
-(put 'or    'byte-optimizer 'byte-optimize-or)
-(put 'cond  'byte-optimizer 'byte-optimize-cond)
-(put 'if    'byte-optimizer 'byte-optimize-if)
-(put 'while 'byte-optimizer 'byte-optimize-while)
-
-;; byte-compile-negation-optimizer lives in bytecomp.el
-(put '/= 'byte-optimizer 'byte-compile-negation-optimizer)
-(put 'atom 'byte-optimizer 'byte-compile-negation-optimizer)
-(put 'nlistp 'byte-optimizer 'byte-compile-negation-optimizer)
-
-
-(defun byte-optimize-funcall (form)
-  ;; (funcall '(lambda ...) ...) ==> ((lambda ...) ...)
-  ;; (funcall 'foo ...) ==> (foo ...)
-  (let ((fn (nth 1 form)))
-    (if (memq (car-safe fn) '(quote function))
-	(cons (nth 1 fn) (cdr (cdr form)))
-	form)))
-
-(defun byte-optimize-apply (form)
-  ;; If the last arg is a literal constant, turn this into a funcall.
-  ;; The funcall optimizer can then transform (funcall 'foo ...) -> (foo ...).
-  (let ((fn (nth 1 form))
-	(last (nth (1- (length form)) form))) ; I think this really is fastest
-    (or (if (or (null last)
-		(eq (car-safe last) 'quote))
-	    (if (listp (nth 1 last))
-		(let ((butlast (nreverse (cdr (reverse (cdr (cdr form)))))))
-		  (nconc (list 'funcall fn) butlast
-			 (mapcar '(lambda (x) (list 'quote x)) (nth 1 last))))
-	      (byte-compile-warn
-	       "last arg to apply can't be a literal atom: %s"
-	       (prin1-to-string last))
-	      nil))
-	form)))
-
-(put 'funcall 'byte-optimizer 'byte-optimize-funcall)
-(put 'apply   'byte-optimizer 'byte-optimize-apply)
-
-
-(put 'let 'byte-optimizer 'byte-optimize-letX)
-(put 'let* 'byte-optimizer 'byte-optimize-letX)
-(defun byte-optimize-letX (form)
-  (cond ((null (nth 1 form))
-	 ;; No bindings
-	 (cons 'progn (cdr (cdr form))))
-	((or (nth 2 form) (nthcdr 3 form))
-	 form)
-	 ;; The body is nil
-	((eq (car form) 'let)
-	 (append '(progn) (mapcar 'car-safe (mapcar 'cdr-safe (nth 1 form)))
-		 '(nil)))
-	(t
-	 (let ((binds (reverse (nth 1 form))))
-	   (list 'let* (reverse (cdr binds)) (nth 1 (car binds)) nil)))))
-
-
-(put 'nth 'byte-optimizer 'byte-optimize-nth)
-(defun byte-optimize-nth (form)
-  (if (and (= (safe-length form) 3) (memq (nth 1 form) '(0 1)))
-      (list 'car (if (zerop (nth 1 form))
-		     (nth 2 form)
-		   (list 'cdr (nth 2 form))))
-    (byte-optimize-predicate form)))
-
-(put 'nthcdr 'byte-optimizer 'byte-optimize-nthcdr)
-(defun byte-optimize-nthcdr (form)
-  (if (and (= (safe-length form) 3) (not (memq (nth 1 form) '(0 1 2))))
-      (byte-optimize-predicate form)
-    (let ((count (nth 1 form)))
-      (setq form (nth 2 form))
-      (while (>= (setq count (1- count)) 0)
-	(setq form (list 'cdr form)))
-      form)))
-
-;;; enumerating those functions which need not be called if the returned 
-;;; value is not used.  That is, something like
-;;;    (progn (list (something-with-side-effects) (yow))
-;;;           (foo))
-;;; may safely be turned into
-;;;    (progn (progn (something-with-side-effects) (yow))
-;;;           (foo))
-;;; Further optimizations will turn (progn (list 1 2 3) 'foo) into 'foo.
-
-;;; I wonder if I missed any :-\)
-(let ((side-effect-free-fns
-       '(% * + - / /= 1+ 1- < <= = > >= abs acos append aref ash asin atan
-	 assoc assq
-	 boundp buffer-file-name buffer-local-variables buffer-modified-p
-	 buffer-substring
-	 capitalize car-less-than-car car cdr ceiling concat coordinates-in-window-p
-	 copy-marker cos count-lines
-	 default-boundp default-value documentation downcase
-	 elt exp expt fboundp featurep
-	 file-directory-p file-exists-p file-locked-p file-name-absolute-p
-	 file-newer-than-file-p file-readable-p file-symlink-p file-writable-p
-	 float floor format
-	 get get-buffer get-buffer-window getenv get-file-buffer
-	 int-to-string
-	 length log log10 logand logb logior lognot logxor lsh
-	 marker-buffer max member memq min mod
-	 next-window nth nthcdr number-to-string
-	 parse-colon-path previous-window
-	 radians-to-degrees rassq regexp-quote reverse round
-	 sin sqrt string< string= string-equal string-lessp string-to-char
-	 string-to-int string-to-number substring symbol-plist
-	 tan upcase user-variable-p vconcat
-	 window-buffer window-dedicated-p window-edges window-height
-	 window-hscroll window-minibuffer-p window-width
-	 zerop))
-      (side-effect-and-error-free-fns
-       '(arrayp atom
-	 bobp bolp buffer-end buffer-list buffer-size buffer-string bufferp
-	 car-safe case-table-p cdr-safe char-or-string-p commandp cons consp
-	 current-buffer
-	 dot dot-marker eobp eolp eq eql equal eventp floatp framep
-	 get-largest-window get-lru-window
-	 identity ignore integerp integer-or-marker-p interactive-p
-	 invocation-directory invocation-name
-	 keymapp list listp
-	 make-marker mark mark-marker markerp memory-limit minibuffer-window
-	 mouse-movement-p
-	 natnump nlistp not null number-or-marker-p numberp
-	 one-window-p overlayp
-	 point point-marker point-min point-max processp
-	 selected-window sequencep stringp subrp symbolp syntax-table-p
-	 user-full-name user-login-name user-original-login-name
-	 user-real-login-name user-real-uid user-uid
-	 vector vectorp
-	 window-configuration-p window-live-p windowp)))
-  (while side-effect-free-fns
-    (put (car side-effect-free-fns) 'side-effect-free t)
-    (setq side-effect-free-fns (cdr side-effect-free-fns)))
-  (while side-effect-and-error-free-fns
-    (put (car side-effect-and-error-free-fns) 'side-effect-free 'error-free)
-    (setq side-effect-and-error-free-fns (cdr side-effect-and-error-free-fns)))
-  nil)
-
-
-(defun byte-compile-splice-in-already-compiled-code (form)
-  ;; form is (byte-code "..." [...] n)
-  (if (not (memq byte-optimize '(t lap)))
-      (byte-compile-normal-call form)
-    (byte-inline-lapcode
-     (byte-decompile-bytecode-1 (nth 1 form) (nth 2 form) t))
-    (setq byte-compile-maxdepth (max (+ byte-compile-depth (nth 3 form))
-				     byte-compile-maxdepth))
-    (setq byte-compile-depth (1+ byte-compile-depth))))
-
-(put 'byte-code 'byte-compile 'byte-compile-splice-in-already-compiled-code)
-
-
-(defconst byte-constref-ops
-  '(byte-constant byte-constant2 byte-varref byte-varset byte-varbind))
-
-;;; This function extracts the bitfields from variable-length opcodes.
-;;; Originally defined in disass.el (which no longer uses it.)
-
-(defun disassemble-offset ()
-  "Don't call this!"
-  ;; fetch and return the offset for the current opcode.
-  ;; return NIL if this opcode has no offset
-  ;; OP, PTR and BYTES are used and set dynamically
-  (defvar op)
-  (defvar ptr)
-  (defvar bytes)
-  (cond ((< op byte-nth)
-	 (let ((tem (logand op 7)))
-	   (setq op (logand op 248))
-	   (cond ((eq tem 6)
-		  (setq ptr (1+ ptr))	;offset in next byte
-		  (aref bytes ptr))
-		 ((eq tem 7)
-		  (setq ptr (1+ ptr))	;offset in next 2 bytes
-		  (+ (aref bytes ptr)
-		     (progn (setq ptr (1+ ptr))
-			    (lsh (aref bytes ptr) 8))))
-		 (t tem))))		;offset was in opcode
-	((>= op byte-constant)
-	 (prog1 (- op byte-constant)	;offset in opcode
-	   (setq op byte-constant)))
-	((and (>= op byte-constant2)
-	      (<= op byte-goto-if-not-nil-else-pop))
-	 (setq ptr (1+ ptr))		;offset in next 2 bytes
-	 (+ (aref bytes ptr)
-	    (progn (setq ptr (1+ ptr))
-		   (lsh (aref bytes ptr) 8))))
-	((and (>= op byte-listN)
-	      (<= op byte-insertN))
-	 (setq ptr (1+ ptr))		;offset in next byte
-	 (aref bytes ptr))))
-
-
-;;; This de-compiler is used for inline expansion of compiled functions,
-;;; and by the disassembler.
-;;;
-;;; This list contains numbers, which are pc values,
-;;; before each instruction.
-(defun byte-decompile-bytecode (bytes constvec)
-  "Turns BYTECODE into lapcode, referring to CONSTVEC."
-  (let ((byte-compile-constants nil)
-	(byte-compile-variables nil)
-	(byte-compile-tag-number 0))
-    (byte-decompile-bytecode-1 bytes constvec)))
-
-;; As byte-decompile-bytecode, but updates
-;; byte-compile-{constants, variables, tag-number}.
-;; If MAKE-SPLICEABLE is true, then `return' opcodes are replaced
-;; with `goto's destined for the end of the code.
-;; That is for use by the compiler.
-;; If MAKE-SPLICEABLE is nil, we are being called for the disassembler.
-;; In that case, we put a pc value into the list
-;; before each insn (or its label).
-(defun byte-decompile-bytecode-1 (bytes constvec &optional make-spliceable)
-  (let ((length (length bytes))
-	(ptr 0) optr tag tags op offset
-	lap tmp
-	endtag
-	(retcount 0))
-    (while (not (= ptr length))
-      (or make-spliceable
-	  (setq lap (cons ptr lap)))
-      (setq op (aref bytes ptr)
-	    optr ptr
-	    offset (disassemble-offset)) ; this does dynamic-scope magic
-      (setq op (aref byte-code-vector op))
-      (cond ((memq op byte-goto-ops)
-	     ;; it's a pc
-	     (setq offset
-		   (cdr (or (assq offset tags)
-			    (car (setq tags
-				       (cons (cons offset
-						   (byte-compile-make-tag))
-					     tags)))))))
-	    ((cond ((eq op 'byte-constant2) (setq op 'byte-constant) t)
-		   ((memq op byte-constref-ops)))
-	     (setq tmp (aref constvec offset)
-		   offset (if (eq op 'byte-constant)
-			      (byte-compile-get-constant tmp)
-			    (or (assq tmp byte-compile-variables)
-				(car (setq byte-compile-variables
-					   (cons (list tmp)
-						 byte-compile-variables)))))))
-	    ((and make-spliceable
-		  (eq op 'byte-return))
-	     (if (= ptr (1- length))
-		 (setq op nil)
-	       (setq offset (or endtag (setq endtag (byte-compile-make-tag)))
-		     op 'byte-goto))))
-      ;; lap = ( [ (pc . (op . arg)) ]* )
-      (setq lap (cons (cons optr (cons op (or offset 0)))
-		      lap))
-      (setq ptr (1+ ptr)))
-    ;; take off the dummy nil op that we replaced a trailing "return" with.
-    (let ((rest lap))
-      (while rest
-	(cond ((numberp (car rest)))
-	      ((setq tmp (assq (car (car rest)) tags))
-	       ;; this addr is jumped to
-	       (setcdr rest (cons (cons nil (cdr tmp))
-				  (cdr rest)))
-	       (setq tags (delq tmp tags))
-	       (setq rest (cdr rest))))
-	(setq rest (cdr rest))))
-    (if tags (error "optimizer error: missed tags %s" tags))
-    (if (null (car (cdr (car lap))))
-	(setq lap (cdr lap)))
-    (if endtag
-	(setq lap (cons (cons nil endtag) lap)))
-    ;; remove addrs, lap = ( [ (op . arg) | (TAG tagno) ]* )
-    (mapcar (function (lambda (elt)
-			(if (numberp elt)
-			    elt
-			  (cdr elt))))
-	    (nreverse lap))))
-
-
-;;; peephole optimizer
-
-(defconst byte-tagref-ops (cons 'TAG byte-goto-ops))
-
-(defconst byte-conditional-ops
-  '(byte-goto-if-nil byte-goto-if-not-nil byte-goto-if-nil-else-pop
-    byte-goto-if-not-nil-else-pop))
-
-(defconst byte-after-unbind-ops
-   '(byte-constant byte-dup
-     byte-symbolp byte-consp byte-stringp byte-listp byte-numberp byte-integerp
-     byte-eq byte-equal byte-not
-     byte-cons byte-list1 byte-list2	; byte-list3 byte-list4
-     byte-interactive-p)
-   ;; How about other side-effect-free-ops?  Is it safe to move an
-   ;; error invocation (such as from nth) out of an unwind-protect?
-   "Byte-codes that can be moved past an unbind.")
-
-(defconst byte-compile-side-effect-and-error-free-ops
-  '(byte-constant byte-dup byte-symbolp byte-consp byte-stringp byte-listp
-    byte-integerp byte-numberp byte-eq byte-equal byte-not byte-car-safe
-    byte-cdr-safe byte-cons byte-list1 byte-list2 byte-point byte-point-max
-    byte-point-min byte-following-char byte-preceding-char
-    byte-current-column byte-eolp byte-eobp byte-bolp byte-bobp
-    byte-current-buffer byte-interactive-p))
-
-(defconst byte-compile-side-effect-free-ops
-  (nconc 
-   '(byte-varref byte-nth byte-memq byte-car byte-cdr byte-length byte-aref
-     byte-symbol-value byte-get byte-concat2 byte-concat3 byte-sub1 byte-add1
-     byte-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate
-     byte-plus byte-max byte-min byte-mult byte-char-after byte-char-syntax
-     byte-buffer-substring byte-string= byte-string< byte-nthcdr byte-elt
-     byte-member byte-assq byte-quo byte-rem)
-   byte-compile-side-effect-and-error-free-ops))
-
-;;; This crock is because of the way DEFVAR_BOOL variables work.
-;;; Consider the code
-;;;
-;;;	(defun foo (flag)
-;;;	  (let ((old-pop-ups pop-up-windows)
-;;;		(pop-up-windows flag))
-;;;	    (cond ((not (eq pop-up-windows old-pop-ups))
-;;;		   (setq old-pop-ups pop-up-windows)
-;;;		   ...))))
-;;;
-;;; Uncompiled, old-pop-ups will always be set to nil or t, even if FLAG is
-;;; something else.  But if we optimize
-;;;
-;;;	varref flag
-;;;	varbind pop-up-windows
-;;;	varref pop-up-windows
-;;;	not
-;;; to
-;;;	varref flag
-;;;	dup
-;;;	varbind pop-up-windows
-;;;	not
-;;;
-;;; we break the program, because it will appear that pop-up-windows and 
-;;; old-pop-ups are not EQ when really they are.  So we have to know what
-;;; the BOOL variables are, and not perform this optimization on them.
-;;;
-(defconst byte-boolean-vars
-  '(abbrev-all-caps abbrevs-changed byte-metering-on
-    cannot-suspend completion-auto-help completion-ignore-case
-    cursor-in-echo-area debug-on-next-call debug-on-quit
-    delete-exited-processes enable-recursive-minibuffers
-    highlight-nonselected-windows indent-tabs-mode inhibit-local-menu-bar-menus
-    insert-default-directory inverse-video load-force-doc-strings
-    load-in-progress menu-prompting minibuffer-auto-raise
-    mode-line-inverse-video multiple-frames no-redraw-on-reenter noninteractive
-    parse-sexp-ignore-comments pop-up-frames pop-up-windows
-    print-escape-newlines system-uses-terminfo truncate-partial-width-windows
-    visible-bell vms-stmlf-recfm words-include-escapes)
-  "DEFVAR_BOOL variables.  Giving these any non-nil value sets them to t.
-If this does not enumerate all DEFVAR_BOOL variables, the byte-optimizer
-may generate incorrect code.")
-
-(defun byte-optimize-lapcode (lap &optional for-effect)
-  "Simple peephole optimizer.  LAP is both modified and returned."
-  (let (lap0 off0
-	lap1 off1
-	lap2 off2
-	(keep-going 'first-time)
-	(add-depth 0)
-	rest tmp tmp2 tmp3
-	(side-effect-free (if byte-compile-delete-errors
-			      byte-compile-side-effect-free-ops
-			    byte-compile-side-effect-and-error-free-ops)))
-    (while keep-going
-      (or (eq keep-going 'first-time)
-	  (byte-compile-log-lap "  ---- next pass"))
-      (setq rest lap
-	    keep-going nil)
-      (while rest
-	(setq lap0 (car rest)
-	      lap1 (nth 1 rest)
-	      lap2 (nth 2 rest))
-
-	;; You may notice that sequences like "dup varset discard" are
-	;; optimized but sequences like "dup varset TAG1: discard" are not.
-	;; You may be tempted to change this; resist that temptation.
-	(cond ;;
-	      ;; <side-effect-free> pop -->  <deleted>
-	      ;;  ...including:
-	      ;; const-X pop   -->  <deleted>
-	      ;; varref-X pop  -->  <deleted>
-	      ;; dup pop       -->  <deleted>
-	      ;;
-	      ((and (eq 'byte-discard (car lap1))
-		    (memq (car lap0) side-effect-free))
-	       (setq keep-going t)
-	       (setq tmp (aref byte-stack+-info (symbol-value (car lap0))))
-	       (setq rest (cdr rest))
-	       (cond ((= tmp 1)
-		      (byte-compile-log-lap
- 		       "  %s discard\t-->\t<deleted>" lap0)
-		      (setq lap (delq lap0 (delq lap1 lap))))
-		     ((= tmp 0)
-		      (byte-compile-log-lap
-		       "  %s discard\t-->\t<deleted> discard" lap0)
-		      (setq lap (delq lap0 lap)))
-		     ((= tmp -1)
-		      (byte-compile-log-lap
-		       "  %s discard\t-->\tdiscard discard" lap0)
-		      (setcar lap0 'byte-discard)
-		      (setcdr lap0 0))
-		     ((error "Optimizer error: too much on the stack"))))
-	      ;;
-	      ;; goto*-X X:  -->  X:
-	      ;;
-	      ((and (memq (car lap0) byte-goto-ops)
-		    (eq (cdr lap0) lap1))
-	       (cond ((eq (car lap0) 'byte-goto)
-		      (setq lap (delq lap0 lap))
-		      (setq tmp "<deleted>"))
-		     ((memq (car lap0) byte-goto-always-pop-ops)
-		      (setcar lap0 (setq tmp 'byte-discard))
-		      (setcdr lap0 0))
-		     ((error "Depth conflict at tag %d" (nth 2 lap0))))
-	       (and (memq byte-optimize-log '(t byte))
-		    (byte-compile-log "  (goto %s) %s:\t-->\t%s %s:"
-				      (nth 1 lap1) (nth 1 lap1)
-				      tmp (nth 1 lap1)))
-	       (setq keep-going t))
-	      ;;
-	      ;; varset-X varref-X  -->  dup varset-X
-	      ;; varbind-X varref-X  -->  dup varbind-X
-	      ;; const/dup varset-X varref-X --> const/dup varset-X const/dup
-	      ;; const/dup varbind-X varref-X --> const/dup varbind-X const/dup
-	      ;; The latter two can enable other optimizations.
-	      ;;
-	      ((and (eq 'byte-varref (car lap2))
-		    (eq (cdr lap1) (cdr lap2))
-		    (memq (car lap1) '(byte-varset byte-varbind)))
-	       (if (and (setq tmp (memq (car (cdr lap2)) byte-boolean-vars))
-			(not (eq (car lap0) 'byte-constant)))
-		   nil
-		 (setq keep-going t)
-		 (if (memq (car lap0) '(byte-constant byte-dup))
-		     (progn
-		       (setq tmp (if (or (not tmp)
-					 (memq (car (cdr lap0)) '(nil t)))
-				     (cdr lap0)
-				   (byte-compile-get-constant t)))
-		       (byte-compile-log-lap "  %s %s %s\t-->\t%s %s %s"
-					     lap0 lap1 lap2 lap0 lap1
-					     (cons (car lap0) tmp))
-		       (setcar lap2 (car lap0))
-		       (setcdr lap2 tmp))
-		   (byte-compile-log-lap "  %s %s\t-->\tdup %s" lap1 lap2 lap1)
-		   (setcar lap2 (car lap1))
-		   (setcar lap1 'byte-dup)
-		   (setcdr lap1 0)
-		   ;; The stack depth gets locally increased, so we will
-		   ;; increase maxdepth in case depth = maxdepth here.
-		   ;; This can cause the third argument to byte-code to
-		   ;; be larger than necessary.
-		   (setq add-depth 1))))
-	      ;;
-	      ;; dup varset-X discard  -->  varset-X
-	      ;; dup varbind-X discard  -->  varbind-X
-	      ;; (the varbind variant can emerge from other optimizations)
-	      ;;
-	      ((and (eq 'byte-dup (car lap0))
-		    (eq 'byte-discard (car lap2))
-		    (memq (car lap1) '(byte-varset byte-varbind)))
-	       (byte-compile-log-lap "  dup %s discard\t-->\t%s" lap1 lap1)
-	       (setq keep-going t
-		     rest (cdr rest))
-	       (setq lap (delq lap0 (delq lap2 lap))))
-	      ;;
-	      ;; not goto-X-if-nil              -->  goto-X-if-non-nil
-	      ;; not goto-X-if-non-nil          -->  goto-X-if-nil
-	      ;;
-	      ;; it is wrong to do the same thing for the -else-pop variants.
-	      ;;
-	      ((and (eq 'byte-not (car lap0))
-		    (or (eq 'byte-goto-if-nil (car lap1))
-			(eq 'byte-goto-if-not-nil (car lap1))))
-	       (byte-compile-log-lap "  not %s\t-->\t%s"
-				     lap1
-				     (cons
-				      (if (eq (car lap1) 'byte-goto-if-nil)
-					  'byte-goto-if-not-nil
-					'byte-goto-if-nil)
-				      (cdr lap1)))
-	       (setcar lap1 (if (eq (car lap1) 'byte-goto-if-nil)
-				'byte-goto-if-not-nil
-				'byte-goto-if-nil))
-	       (setq lap (delq lap0 lap))
-	       (setq keep-going t))
-	      ;;
-	      ;; goto-X-if-nil     goto-Y X:  -->  goto-Y-if-non-nil X:
-	      ;; goto-X-if-non-nil goto-Y X:  -->  goto-Y-if-nil     X:
-	      ;;
-	      ;; it is wrong to do the same thing for the -else-pop variants.
-	      ;; 
-	      ((and (or (eq 'byte-goto-if-nil (car lap0))
-			(eq 'byte-goto-if-not-nil (car lap0)))	; gotoX
-		    (eq 'byte-goto (car lap1))			; gotoY
-		    (eq (cdr lap0) lap2))			; TAG X
-	       (let ((inverse (if (eq 'byte-goto-if-nil (car lap0))
-				  'byte-goto-if-not-nil 'byte-goto-if-nil)))
-		 (byte-compile-log-lap "  %s %s %s:\t-->\t%s %s:"
-				       lap0 lap1 lap2
-				       (cons inverse (cdr lap1)) lap2)
-		 (setq lap (delq lap0 lap))
-		 (setcar lap1 inverse)
-		 (setq keep-going t)))
-	      ;;
-	      ;; const goto-if-* --> whatever
-	      ;;
-	      ((and (eq 'byte-constant (car lap0))
-		    (memq (car lap1) byte-conditional-ops))
-	       (cond ((if (or (eq (car lap1) 'byte-goto-if-nil)
-			      (eq (car lap1) 'byte-goto-if-nil-else-pop))
-			  (car (cdr lap0))
-			(not (car (cdr lap0))))
-		      (byte-compile-log-lap "  %s %s\t-->\t<deleted>"
-					    lap0 lap1)
-		      (setq rest (cdr rest)
-			    lap (delq lap0 (delq lap1 lap))))
-		     (t
-		      (if (memq (car lap1) byte-goto-always-pop-ops)
-			  (progn
-			    (byte-compile-log-lap "  %s %s\t-->\t%s"
-			     lap0 lap1 (cons 'byte-goto (cdr lap1)))
-			    (setq lap (delq lap0 lap)))
-			(byte-compile-log-lap "  %s %s\t-->\t%s" lap0 lap1
-			 (cons 'byte-goto (cdr lap1))))
-		      (setcar lap1 'byte-goto)))
-	       (setq keep-going t))
-	      ;;
-	      ;; varref-X varref-X  -->  varref-X dup
-	      ;; varref-X [dup ...] varref-X  -->  varref-X [dup ...] dup
-	      ;; We don't optimize the const-X variations on this here,
-	      ;; because that would inhibit some goto optimizations; we
-	      ;; optimize the const-X case after all other optimizations.
-	      ;;
-	      ((and (eq 'byte-varref (car lap0))
-		    (progn
-		      (setq tmp (cdr rest))
-		      (while (eq (car (car tmp)) 'byte-dup)
-			(setq tmp (cdr tmp)))
-		      t)
-		    (eq (cdr lap0) (cdr (car tmp)))
-		    (eq 'byte-varref (car (car tmp))))
-	       (if (memq byte-optimize-log '(t byte))
-		   (let ((str ""))
-		     (setq tmp2 (cdr rest))
-		     (while (not (eq tmp tmp2))
-		       (setq tmp2 (cdr tmp2)
-			     str (concat str " dup")))
-		     (byte-compile-log-lap "  %s%s %s\t-->\t%s%s dup"
-					   lap0 str lap0 lap0 str)))
-	       (setq keep-going t)
-	       (setcar (car tmp) 'byte-dup)
-	       (setcdr (car tmp) 0)
-	       (setq rest tmp))
-	      ;;
-	      ;; TAG1: TAG2: --> TAG1: <deleted>
-	      ;; (and other references to TAG2 are replaced with TAG1)
-	      ;;
-	      ((and (eq (car lap0) 'TAG)
-		    (eq (car lap1) 'TAG))
-	       (and (memq byte-optimize-log '(t byte))
-		    (byte-compile-log "  adjacent tags %d and %d merged"
-				      (nth 1 lap1) (nth 1 lap0)))
-	       (setq tmp3 lap)
-	       (while (setq tmp2 (rassq lap0 tmp3))
-		 (setcdr tmp2 lap1)
-		 (setq tmp3 (cdr (memq tmp2 tmp3))))
-	       (setq lap (delq lap0 lap)
-		     keep-going t))
-	      ;;
-	      ;; unused-TAG: --> <deleted>
-	      ;;
-	      ((and (eq 'TAG (car lap0))
-		    (not (rassq lap0 lap)))
-	       (and (memq byte-optimize-log '(t byte))
-		    (byte-compile-log "  unused tag %d removed" (nth 1 lap0)))
-	       (setq lap (delq lap0 lap)
-		     keep-going t))
-	      ;;
-	      ;; goto   ... --> goto   <delete until TAG or end>
-	      ;; return ... --> return <delete until TAG or end>
-	      ;;
-	      ((and (memq (car lap0) '(byte-goto byte-return))
-		    (not (memq (car lap1) '(TAG nil))))
-	       (setq tmp rest)
-	       (let ((i 0)
-		     (opt-p (memq byte-optimize-log '(t lap)))
-		     str deleted)
-		 (while (and (setq tmp (cdr tmp))
-			     (not (eq 'TAG (car (car tmp)))))
-		   (if opt-p (setq deleted (cons (car tmp) deleted)
-				   str (concat str " %s")
-				   i (1+ i))))
-		 (if opt-p
-		     (let ((tagstr 
-			    (if (eq 'TAG (car (car tmp)))
-				(format "%d:" (car (cdr (car tmp))))
-			      (or (car tmp) ""))))
-		       (if (< i 6)
-			   (apply 'byte-compile-log-lap-1
-				  (concat "  %s" str
-					  " %s\t-->\t%s <deleted> %s")
-				  lap0
-				  (nconc (nreverse deleted)
-					 (list tagstr lap0 tagstr)))
-			 (byte-compile-log-lap
-			  "  %s <%d unreachable op%s> %s\t-->\t%s <deleted> %s"
-			  lap0 i (if (= i 1) "" "s")
-			  tagstr lap0 tagstr))))
-		 (rplacd rest tmp))
-	       (setq keep-going t))
-	      ;;
-	      ;; <safe-op> unbind --> unbind <safe-op>
-	      ;; (this may enable other optimizations.)
-	      ;;
-	      ((and (eq 'byte-unbind (car lap1))
-		    (memq (car lap0) byte-after-unbind-ops))
-	       (byte-compile-log-lap "  %s %s\t-->\t%s %s" lap0 lap1 lap1 lap0)
-	       (setcar rest lap1)
-	       (setcar (cdr rest) lap0)
-	       (setq keep-going t))
-	      ;;
-	      ;; varbind-X unbind-N         -->  discard unbind-(N-1)
-	      ;; save-excursion unbind-N    -->  unbind-(N-1)
-	      ;; save-restriction unbind-N  -->  unbind-(N-1)
-	      ;;
-	      ((and (eq 'byte-unbind (car lap1))
-		    (memq (car lap0) '(byte-varbind byte-save-excursion
-				       byte-save-restriction))
-		    (< 0 (cdr lap1)))
-	       (if (zerop (setcdr lap1 (1- (cdr lap1))))
-		   (delq lap1 rest))
-	       (if (eq (car lap0) 'byte-varbind)
-		   (setcar rest (cons 'byte-discard 0))
-		 (setq lap (delq lap0 lap)))
-	       (byte-compile-log-lap "  %s %s\t-->\t%s %s"
-		 lap0 (cons (car lap1) (1+ (cdr lap1)))
-		 (if (eq (car lap0) 'byte-varbind)
-		     (car rest)
-		   (car (cdr rest)))
-		 (if (and (/= 0 (cdr lap1))
-			  (eq (car lap0) 'byte-varbind))
-		     (car (cdr rest))
-		   ""))
-	       (setq keep-going t))
-	      ;;
-	      ;; goto*-X ... X: goto-Y  --> goto*-Y
-	      ;; goto-X ...  X: return  --> return
-	      ;;
-	      ((and (memq (car lap0) byte-goto-ops)
-		    (memq (car (setq tmp (nth 1 (memq (cdr lap0) lap))))
-			  '(byte-goto byte-return)))
-	       (cond ((and (not (eq tmp lap0))
-			   (or (eq (car lap0) 'byte-goto)
-			       (eq (car tmp) 'byte-goto)))
-		      (byte-compile-log-lap "  %s [%s]\t-->\t%s"
-					    (car lap0) tmp tmp)
-		      (if (eq (car tmp) 'byte-return)
-			  (setcar lap0 'byte-return))
-		      (setcdr lap0 (cdr tmp))
-		      (setq keep-going t))))
-	      ;;
-	      ;; goto-*-else-pop X ... X: goto-if-* --> whatever
-	      ;; goto-*-else-pop X ... X: discard --> whatever
-	      ;;
-	      ((and (memq (car lap0) '(byte-goto-if-nil-else-pop
-				       byte-goto-if-not-nil-else-pop))
-		    (memq (car (car (setq tmp (cdr (memq (cdr lap0) lap)))))
-			  (eval-when-compile
-			   (cons 'byte-discard byte-conditional-ops)))
-		    (not (eq lap0 (car tmp))))
-	       (setq tmp2 (car tmp))
-	       (setq tmp3 (assq (car lap0) '((byte-goto-if-nil-else-pop
-					      byte-goto-if-nil)
-					     (byte-goto-if-not-nil-else-pop
-					      byte-goto-if-not-nil))))
-	       (if (memq (car tmp2) tmp3)
-		   (progn (setcar lap0 (car tmp2))
-			  (setcdr lap0 (cdr tmp2))
-			  (byte-compile-log-lap "  %s-else-pop [%s]\t-->\t%s"
-						(car lap0) tmp2 lap0))
-		 ;; Get rid of the -else-pop's and jump one step further.
-		 (or (eq 'TAG (car (nth 1 tmp)))
-		     (setcdr tmp (cons (byte-compile-make-tag)
-				       (cdr tmp))))
-		 (byte-compile-log-lap "  %s [%s]\t-->\t%s <skip>"
-				       (car lap0) tmp2 (nth 1 tmp3))
-		 (setcar lap0 (nth 1 tmp3))
-		 (setcdr lap0 (nth 1 tmp)))
-	       (setq keep-going t))
-	      ;;
-	      ;; const goto-X ... X: goto-if-* --> whatever
-	      ;; const goto-X ... X: discard   --> whatever
-	      ;;
-	      ((and (eq (car lap0) 'byte-constant)
-		    (eq (car lap1) 'byte-goto)
-		    (memq (car (car (setq tmp (cdr (memq (cdr lap1) lap)))))
-			  (eval-when-compile
-			    (cons 'byte-discard byte-conditional-ops)))
-		    (not (eq lap1 (car tmp))))
-	       (setq tmp2 (car tmp))
-	       (cond ((memq (car tmp2)
-			    (if (null (car (cdr lap0)))
-				'(byte-goto-if-nil byte-goto-if-nil-else-pop)
-			      '(byte-goto-if-not-nil
-				byte-goto-if-not-nil-else-pop)))
-		      (byte-compile-log-lap "  %s goto [%s]\t-->\t%s %s"
-					    lap0 tmp2 lap0 tmp2)
-		      (setcar lap1 (car tmp2))
-		      (setcdr lap1 (cdr tmp2))
-		      ;; Let next step fix the (const,goto-if*) sequence.
-		      (setq rest (cons nil rest)))
-		     (t
-		      ;; Jump one step further
-		      (byte-compile-log-lap
-		       "  %s goto [%s]\t-->\t<deleted> goto <skip>"
-		       lap0 tmp2)
-		      (or (eq 'TAG (car (nth 1 tmp)))
-			  (setcdr tmp (cons (byte-compile-make-tag)
-					    (cdr tmp))))
-		      (setcdr lap1 (car (cdr tmp)))
-		      (setq lap (delq lap0 lap))))
-	       (setq keep-going t))
-	      ;;
-	      ;; X: varref-Y    ...     varset-Y goto-X  -->
-	      ;; X: varref-Y Z: ... dup varset-Y goto-Z
-	      ;; (varset-X goto-BACK, BACK: varref-X --> copy the varref down.)
-	      ;; (This is so usual for while loops that it is worth handling).
-	      ;;
-	      ((and (eq (car lap1) 'byte-varset)
-		    (eq (car lap2) 'byte-goto)
-		    (not (memq (cdr lap2) rest)) ;Backwards jump
-		    (eq (car (car (setq tmp (cdr (memq (cdr lap2) lap)))))
-			'byte-varref)
-		    (eq (cdr (car tmp)) (cdr lap1))
-		    (not (memq (car (cdr lap1)) byte-boolean-vars)))
-	       ;;(byte-compile-log-lap "  Pulled %s to end of loop" (car tmp))
-	       (let ((newtag (byte-compile-make-tag)))
-		 (byte-compile-log-lap
-		  "  %s: %s ... %s %s\t-->\t%s: %s %s: ... %s %s %s"
-		  (nth 1 (cdr lap2)) (car tmp)
-                  lap1 lap2
-		  (nth 1 (cdr lap2)) (car tmp)
-		  (nth 1 newtag) 'byte-dup lap1
-		  (cons 'byte-goto newtag)
-		  )
-		 (setcdr rest (cons (cons 'byte-dup 0) (cdr rest)))
-		 (setcdr tmp (cons (setcdr lap2 newtag) (cdr tmp))))
-	       (setq add-depth 1)
-	       (setq keep-going t))
-	      ;;
-	      ;; goto-X Y: ... X: goto-if*-Y  -->  goto-if-not-*-X+1 Y:
-	      ;; (This can pull the loop test to the end of the loop)
-	      ;;
-	      ((and (eq (car lap0) 'byte-goto)
-		    (eq (car lap1) 'TAG)
-		    (eq lap1
-			(cdr (car (setq tmp (cdr (memq (cdr lap0) lap))))))
-		    (memq (car (car tmp))
-			  '(byte-goto byte-goto-if-nil byte-goto-if-not-nil
-				      byte-goto-if-nil-else-pop)))
-;;	       (byte-compile-log-lap "  %s %s, %s %s  --> moved conditional"
-;;				     lap0 lap1 (cdr lap0) (car tmp))
-	       (let ((newtag (byte-compile-make-tag)))
-		 (byte-compile-log-lap
-		  "%s %s: ... %s: %s\t-->\t%s ... %s:"
-		  lap0 (nth 1 lap1) (nth 1 (cdr lap0)) (car tmp)
-		  (cons (cdr (assq (car (car tmp))
-				   '((byte-goto-if-nil . byte-goto-if-not-nil)
-				     (byte-goto-if-not-nil . byte-goto-if-nil)
-				     (byte-goto-if-nil-else-pop .
-				      byte-goto-if-not-nil-else-pop)
-				     (byte-goto-if-not-nil-else-pop .
-				      byte-goto-if-nil-else-pop))))
-			newtag)
-		  
-		  (nth 1 newtag)
-		  )
-		 (setcdr tmp (cons (setcdr lap0 newtag) (cdr tmp)))
-		 (if (eq (car (car tmp)) 'byte-goto-if-nil-else-pop)
-		     ;; We can handle this case but not the -if-not-nil case,
-		     ;; because we won't know which non-nil constant to push.
-		   (setcdr rest (cons (cons 'byte-constant
-					    (byte-compile-get-constant nil))
-				      (cdr rest))))
-	       (setcar lap0 (nth 1 (memq (car (car tmp))
-					 '(byte-goto-if-nil-else-pop
-					   byte-goto-if-not-nil
-					   byte-goto-if-nil
-					   byte-goto-if-not-nil
-					   byte-goto byte-goto))))
-	       )
-	       (setq keep-going t))
-	      )
-	(setq rest (cdr rest)))
-      )
-    ;; Cleanup stage:
-    ;; Rebuild byte-compile-constants / byte-compile-variables.
-    ;; Simple optimizations that would inhibit other optimizations if they
-    ;; were done in the optimizing loop, and optimizations which there is no
-    ;;  need to do more than once.
-    (setq byte-compile-constants nil
-	  byte-compile-variables nil)
-    (setq rest lap)
-    (while rest
-      (setq lap0 (car rest)
-	    lap1 (nth 1 rest))
-      (if (memq (car lap0) byte-constref-ops)
-	  (if (eq (cdr lap0) 'byte-constant)
-	      (or (memq (cdr lap0) byte-compile-variables)
-		  (setq byte-compile-variables (cons (cdr lap0)
-						     byte-compile-variables)))
-	    (or (memq (cdr lap0) byte-compile-constants)
-		(setq byte-compile-constants (cons (cdr lap0)
-						   byte-compile-constants)))))
-      (cond (;;
-	     ;; const-C varset-X const-C  -->  const-C dup varset-X
-	     ;; const-C varbind-X const-C  -->  const-C dup varbind-X
-	     ;;
-	     (and (eq (car lap0) 'byte-constant)
-		  (eq (car (nth 2 rest)) 'byte-constant)
-		  (eq (cdr lap0) (car (nth 2 rest)))
-		  (memq (car lap1) '(byte-varbind byte-varset)))
-	     (byte-compile-log-lap "  %s %s %s\t-->\t%s dup %s"
-				   lap0 lap1 lap0 lap0 lap1)
-	     (setcar (cdr (cdr rest)) (cons (car lap1) (cdr lap1)))
-	     (setcar (cdr rest) (cons 'byte-dup 0))
-	     (setq add-depth 1))
-	    ;;
-	    ;; const-X  [dup/const-X ...]   -->  const-X  [dup ...] dup
-	    ;; varref-X [dup/varref-X ...]  -->  varref-X [dup ...] dup
-	    ;;
-	    ((memq (car lap0) '(byte-constant byte-varref))
-	     (setq tmp rest
-		   tmp2 nil)
-	     (while (progn
-		      (while (eq 'byte-dup (car (car (setq tmp (cdr tmp))))))
-		      (and (eq (cdr lap0) (cdr (car tmp)))
-			   (eq (car lap0) (car (car tmp)))))
-	       (setcar tmp (cons 'byte-dup 0))
-	       (setq tmp2 t))
-	     (if tmp2
-		 (byte-compile-log-lap
-		  "  %s [dup/%s]...\t-->\t%s dup..." lap0 lap0 lap0)))
-	    ;;
-	    ;; unbind-N unbind-M  -->  unbind-(N+M)
-	    ;;
-	    ((and (eq 'byte-unbind (car lap0))
-		  (eq 'byte-unbind (car lap1)))
-	     (byte-compile-log-lap "  %s %s\t-->\t%s" lap0 lap1
-				   (cons 'byte-unbind
-					 (+ (cdr lap0) (cdr lap1))))
-	     (setq keep-going t)
-	     (setq lap (delq lap0 lap))
-	     (setcdr lap1 (+ (cdr lap1) (cdr lap0))))
-	    )
-      (setq rest (cdr rest)))
-    (setq byte-compile-maxdepth (+ byte-compile-maxdepth add-depth)))
-  lap)
-
-(provide 'byte-optimize)
-
-
-;; To avoid "lisp nesting exceeds max-lisp-eval-depth" when this file compiles
-;; itself, compile some of its most used recursive functions (at load time).
-;;
-(eval-when-compile
- (or (byte-code-function-p (symbol-function 'byte-optimize-form))
-     (assq 'byte-code (symbol-function 'byte-optimize-form))
-     (let ((byte-optimize nil)
-	   (byte-compile-warnings nil))
-       (mapcar '(lambda (x)
-		  (or noninteractive (message "compiling %s..." x))
-		  (byte-compile x)
-		  (or noninteractive (message "compiling %s...done" x)))
-	       '(byte-optimize-form
-		 byte-optimize-body
-		 byte-optimize-predicate
-		 byte-optimize-binary-predicate
-		 ;; Inserted some more than necessary, to speed it up.
-		 byte-optimize-form-code-walker
-		 byte-optimize-lapcode))))
- nil)
-
-;;; byte-opt.el ends here
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
deleted file mode 100644
index 1ffd3cae2ca..00000000000
--- a/lisp/emacs-lisp/bytecomp.el
+++ /dev/null
@@ -1,3427 +0,0 @@
-;;; bytecomp.el --- compilation of Lisp code into byte code.
-
-;; Copyright (C) 1985, 1986, 1987, 1992, 1994 Free Software Foundation, Inc.
-
-;; Author: Jamie Zawinski <jwz@lucid.com>
-;;	Hallvard Furuseth <hbf@ulrik.uio.no>
-;; Keywords: internal
-
-;; Subsequently modified by RMS.
-
-;;; This version incorporates changes up to version 2.10 of the 
-;;; Zawinski-Furuseth compiler.
-(defconst byte-compile-version "$Revision: 2.24 $")
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; The Emacs Lisp byte compiler.  This crunches lisp source into a sort
-;; of p-code which takes up less space and can be interpreted faster.
-;; The user entry points are byte-compile-file and byte-recompile-directory.
-
-;;; Code:
-
-;; ========================================================================
-;; Entry points:
-;;	byte-recompile-directory, byte-compile-file,
-;;     batch-byte-compile, batch-byte-recompile-directory,
-;;	byte-compile, compile-defun,
-;;	display-call-tree
-;; (byte-compile-buffer and byte-compile-and-load-file were turned off
-;;  because they are not terribly useful and get in the way of completion.)
-
-;; This version of the byte compiler has the following improvements:
-;;  + optimization of compiled code:
-;;    - removal of unreachable code;
-;;    - removal of calls to side-effectless functions whose return-value
-;;      is unused;
-;;    - compile-time evaluation of safe constant forms, such as (consp nil)
-;;      and (ash 1 6);
-;;    - open-coding of literal lambdas;
-;;    - peephole optimization of emitted code;
-;;    - trivial functions are left uncompiled for speed.
-;;  + support for inline functions;
-;;  + compile-time evaluation of arbitrary expressions;
-;;  + compile-time warning messages for:
-;;    - functions being redefined with incompatible arglists;
-;;    - functions being redefined as macros, or vice-versa;
-;;    - functions or macros defined multiple times in the same file;
-;;    - functions being called with the incorrect number of arguments;
-;;    - functions being called which are not defined globally, in the 
-;;      file, or as autoloads;
-;;    - assignment and reference of undeclared free variables;
-;;    - various syntax errors;
-;;  + correct compilation of nested defuns, defmacros, defvars and defsubsts;
-;;  + correct compilation of top-level uses of macros;
-;;  + the ability to generate a histogram of functions called.
-
-;; User customization variables:
-;;
-;; byte-compile-verbose	Whether to report the function currently being
-;;				compiled in the minibuffer;
-;; byte-optimize		Whether to do optimizations; this may be 
-;;				t, nil, 'source, or 'byte;
-;; byte-optimize-log		Whether to report (in excruciating detail) 
-;;				exactly which optimizations have been made.
-;;				This may be t, nil, 'source, or 'byte;
-;; byte-compile-error-on-warn	Whether to stop compilation when a warning is
-;;				produced;
-;; byte-compile-delete-errors	Whether the optimizer may delete calls or
-;;				variable references that are side-effect-free
-;;				except that they may return an error.
-;; byte-compile-generate-call-tree	Whether to generate a histogram of
-;;				function calls.  This can be useful for 
-;;				finding unused functions, as well as simple
-;;				performance metering.
-;; byte-compile-warnings	List of warnings to issue, or t.  May contain
-;;				'free-vars (references to variables not in the
-;;					    current lexical scope)
-;;				'unresolved (calls to unknown functions)
-;;				'callargs  (lambda calls with args that don't
-;;					    match the lambda's definition)
-;;				'redefine  (function cell redefined from
-;;					    a macro to a lambda or vice versa,
-;;					    or redefined to take other args)
-;;				'obsolete  (obsolete variables and functions)
-;; byte-compile-compatibility	Whether the compiler should
-;;				generate .elc files which can be loaded into
-;;				generic emacs 18.
-;; emacs-lisp-file-regexp	Regexp for the extension of source-files;
-;;				see also the function byte-compile-dest-file.
-
-;; New Features:
-;;
-;;  o	The form `defsubst' is just like `defun', except that the function
-;;	generated will be open-coded in compiled code which uses it.  This
-;;	means that no function call will be generated, it will simply be
-;;	spliced in.  Lisp functions calls are very slow, so this can be a
-;;	big win.
-;;
-;;	You can generally accomplish the same thing with `defmacro', but in
-;;	that case, the defined procedure can't be used as an argument to
-;;	mapcar, etc.
-;;
-;;  o	You can also open-code one particular call to a function without
-;;	open-coding all calls.  Use the 'inline' form to do this, like so:
-;;
-;;		(inline (foo 1 2 3))	;; `foo' will be open-coded
-;;	or...
-;;		(inline			;;  `foo' and `baz' will be 
-;;		 (foo 1 2 3 (bar 5))	;; open-coded, but `bar' will not.
-;;		 (baz 0))
-;;
-;;  o	It is possible to open-code a function in the same file it is defined
-;;	in without having to load that file before compiling it.  the
-;;	byte-compiler has been modified to remember function definitions in
-;;	the compilation environment in the same way that it remembers macro
-;;	definitions.
-;;
-;;  o  Forms like ((lambda ...) ...) are open-coded.
-;;
-;;  o  The form `eval-when-compile' is like progn, except that the body
-;;     is evaluated at compile-time.  When it appears at top-level, this
-;;     is analogous to the Common Lisp idiom (eval-when (compile) ...).
-;;     When it does not appear at top-level, it is similar to the
-;;     Common Lisp #. reader macro (but not in interpreted code).
-;;
-;;  o  The form `eval-and-compile' is similar to eval-when-compile, but
-;;	the whole form is evalled both at compile-time and at run-time.
-;;
-;;  o  The command compile-defun is analogous to eval-defun.
-;;
-;;  o  If you run byte-compile-file on a filename which is visited in a 
-;;     buffer, and that buffer is modified, you are asked whether you want
-;;     to save the buffer before compiling.
-;;
-;;  o  byte-compiled files now start with the string `;ELC'.
-;;     Some versions of `file' can be customized to recognize that.
-
-(require 'backquote)
-
-(or (fboundp 'defsubst)
-    ;; This really ought to be loaded already!
-    (load-library "byte-run"))
-
-;;; The feature of compiling in a specific target Emacs version
-;;; has been turned off because compile time options are a bad idea.
-(defmacro byte-compile-single-version () nil)
-(defmacro byte-compile-version-cond (cond) cond)
-
-;;; The crud you see scattered through this file of the form
-;;;   (or (and (boundp 'epoch::version) epoch::version)
-;;;	  (string-lessp emacs-version "19"))
-;;; is because the Epoch folks couldn't be bothered to follow the
-;;; normal emacs version numbering convention.
-
-;; (if (byte-compile-version-cond
-;;      (or (and (boundp 'epoch::version) epoch::version)
-;; 	 (string-lessp emacs-version "19")))
-;;     (progn
-;;       ;; emacs-18 compatibility.
-;;       (defvar baud-rate (baud-rate))	;Define baud-rate if it's undefined
-;; 
-;;       (if (byte-compile-single-version)
-;; 	  (defmacro byte-code-function-p (x) "Emacs 18 doesn't have these." nil)
-;; 	(defun byte-code-function-p (x) "Emacs 18 doesn't have these." nil))
-;; 
-;;       (or (and (fboundp 'member)
-;; 	       ;; avoid using someone else's possibly bogus definition of this.
-;; 	       (subrp (symbol-function 'member)))
-;; 	  (defun member (elt list)
-;; 	    "like memq, but uses equal instead of eq.  In v19, this is a subr."
-;; 	    (while (and list (not (equal elt (car list))))
-;; 	      (setq list (cdr list)))
-;; 	    list))))
-
-
-(defvar emacs-lisp-file-regexp (if (eq system-type 'vax-vms)
-				   "\\.EL\\(;[0-9]+\\)?$"
-				 "\\.el$")
-  "*Regexp which matches Emacs Lisp source files.
-You may want to redefine `byte-compile-dest-file' if you change this.")
-
-;; This enables file name handlers such as jka-compr
-;; to remove parts of the file name that should not be copied
-;; through to the output file name.
-(defun byte-compiler-base-file-name (filename)
-  (let ((handler (find-file-name-handler filename
-					 'byte-compiler-base-file-name)))
-    (if handler
-	(funcall handler 'byte-compiler-base-file-name filename)
-      filename)))
-
-(or (fboundp 'byte-compile-dest-file)
-    ;; The user may want to redefine this along with emacs-lisp-file-regexp,
-    ;; so only define it if it is undefined.
-    (defun byte-compile-dest-file (filename)
-      "Convert an Emacs Lisp source file name to a compiled file name."
-      (setq filename (byte-compiler-base-file-name filename))
-      (setq filename (file-name-sans-versions filename))
-      (cond ((eq system-type 'vax-vms)
-		 (concat (substring filename 0 (string-match ";" filename)) "c"))
-		((string-match emacs-lisp-file-regexp filename)
-		 (concat (substring filename 0 (match-beginning 0)) ".elc"))
-		(t (concat filename ".elc")))))
-
-;; This can be the 'byte-compile property of any symbol.
-(autoload 'byte-compile-inline-expand "byte-opt")
-
-;; This is the entrypoint to the lapcode optimizer pass1.
-(autoload 'byte-optimize-form "byte-opt")
-;; This is the entrypoint to the lapcode optimizer pass2.
-(autoload 'byte-optimize-lapcode "byte-opt")
-(autoload 'byte-compile-unfold-lambda "byte-opt")
-
-;; This is the entry point to the decompiler, which is used by the
-;; disassembler.  The disassembler just requires 'byte-compile, but
-;; that doesn't define this function, so this seems to be a reasonable
-;; thing to do.
-(autoload 'byte-decompile-bytecode "byte-opt")
-
-(defvar byte-compile-verbose
-  (and (not noninteractive) (> baud-rate search-slow-speed))
-  "*Non-nil means print messages describing progress of byte-compiler.")
-
-(defvar byte-compile-compatibility nil
-  "*Non-nil means generate output that can run in Emacs 18.")
-
-;; (defvar byte-compile-generate-emacs19-bytecodes
-;;         (not (or (and (boundp 'epoch::version) epoch::version)
-;; 		 (string-lessp emacs-version "19")))
-;;   "*If this is true, then the byte-compiler will generate bytecode which 
-;; makes use of byte-ops which are present only in Emacs 19.  Code generated
-;; this way can never be run in Emacs 18, and may even cause it to crash.")
-
-(defvar byte-optimize t
-  "*Enables optimization in the byte compiler.
-nil means don't do any optimization.
-t means do all optimizations.
-`source' means do source-level optimizations only.
-`byte' means do code-level optimizations only.")
-
-(defvar byte-compile-delete-errors t
-  "*If non-nil, the optimizer may delete forms that may signal an error.
-This includes variable references and calls to functions such as `car'.")
-
-(defvar byte-compile-dynamic nil
-  "*If non-nil, compile function bodies so they load lazily.
-They are hidden comments in the compiled file, and brought into core when the
-function is called.
-
-To enable this option, make it a file-local variable
-in the source file you want it to apply to.
-For example, add  -*-byte-compile-dynamic: t;-*- on the first line.
-
-When this option is true, if you load the compiled file and then move it,
-the functions you loaded will not be able to run.")
-
-(defvar byte-compile-dynamic-docstrings t
-  "*If non-nil, compile doc strings for lazy access.
-We bury the doc strings of functions and variables
-inside comments in the file, and bring them into core only when they
-are actually needed.
-
-When this option is true, if you load the compiled file and then move it,
-you won't be able to find the documentation of anything in that file.
-
-To disable this option for a certain file, make it a file-local variable
-in the source file.  For example, add this to the first line:
-  -*-byte-compile-dynamic-docstrings:nil;-*-
-You can also set the variable globally.
-
-This option is enabled by default because it reduces Emacs memory usage.")
-
-(defvar byte-optimize-log nil
-  "*If true, the byte-compiler will log its optimizations into *Compile-Log*.
-If this is 'source, then only source-level optimizations will be logged.
-If it is 'byte, then only byte-level optimizations will be logged.")
-
-(defvar byte-compile-error-on-warn nil
-  "*If true, the byte-compiler reports warnings with `error'.")
-
-(defconst byte-compile-warning-types
-  '(redefine callargs free-vars unresolved obsolete))
-(defvar byte-compile-warnings t
-  "*List of warnings that the byte-compiler should issue (t for all).
-Elements of the list may be be:
-
-  free-vars   references to variables not in the current lexical scope.
-  unresolved  calls to unknown functions.
-  callargs    lambda calls with args that don't match the definition.
-  redefine    function cell redefined from a macro to a lambda or vice
-              versa, or redefined to take a different number of arguments.
-  obsolete      obsolete variables and functions.
-
-See also the macro `byte-compiler-options'.")
-
-(defvar byte-compile-generate-call-tree nil
-  "*Non-nil means collect call-graph information when compiling.
-This records functions were called and from where.
-If the value is t, compilation displays the call graph when it finishes.
-If the value is neither t nor nil, compilation asks you whether to display
-the graph.
-
-The call tree only lists functions called, not macros used. Those functions
-which the byte-code interpreter knows about directly (eq, cons, etc.) are
-not reported.
-
-The call tree also lists those functions which are not known to be called
-\(that is, to which no calls have been compiled).  Functions which can be
-invoked interactively are excluded from this list.")
-
-(defconst byte-compile-call-tree nil "Alist of functions and their call tree.
-Each element looks like
-
-  \(FUNCTION CALLERS CALLS\)
-
-where CALLERS is a list of functions that call FUNCTION, and CALLS
-is a list of functions for which calls were generated while compiling
-FUNCTION.")
-
-(defvar byte-compile-call-tree-sort 'name
-  "*If non-nil, sort the call tree.
-The values `name', `callers', `calls', `calls+callers'
-specify different fields to sort on.")
-
-;; (defvar byte-compile-overwrite-file t
-;;   "If nil, old .elc files are deleted before the new is saved, and .elc
-;; files will have the same modes as the corresponding .el file.  Otherwise,
-;; existing .elc files will simply be overwritten, and the existing modes
-;; will not be changed.  If this variable is nil, then an .elc file which 
-;; is a symbolic link will be turned into a normal file, instead of the file
-;; which the link points to being overwritten.")
-
-(defvar byte-compile-constants nil
-  "list of all constants encountered during compilation of this form")
-(defvar byte-compile-variables nil
-  "list of all variables encountered during compilation of this form")
-(defvar byte-compile-bound-variables nil
-  "list of variables bound in the context of the current form; this list
-lives partly on the stack.")
-(defvar byte-compile-free-references)
-(defvar byte-compile-free-assignments)
-
-(defvar byte-compiler-error-flag)
-
-(defconst byte-compile-initial-macro-environment
-  '(
-;;     (byte-compiler-options . (lambda (&rest forms)
-;; 			       (apply 'byte-compiler-options-handler forms)))
-    (eval-when-compile . (lambda (&rest body)
-			   (list 'quote (eval (byte-compile-top-level
-					       (cons 'progn body))))))
-    (eval-and-compile . (lambda (&rest body)
-			  (eval (cons 'progn body))
-			  (cons 'progn body))))
-  "The default macro-environment passed to macroexpand by the compiler.
-Placing a macro here will cause a macro to have different semantics when
-expanded by the compiler as when expanded by the interpreter.")
-
-(defvar byte-compile-macro-environment byte-compile-initial-macro-environment
-  "Alist of macros defined in the file being compiled.
-Each element looks like (MACRONAME . DEFINITION).  It is
-\(MACRONAME . nil) when a macro is redefined as a function.")
-
-(defvar byte-compile-function-environment nil
-  "Alist of functions defined in the file being compiled.
-This is so we can inline them when necessary.
-Each element looks like (FUNCTIONNAME . DEFINITION).  It is
-\(FUNCTIONNAME . nil) when a function is redefined as a macro.")
-
-(defvar byte-compile-unresolved-functions nil
-  "Alist of undefined functions to which calls have been compiled (used for
-warnings when the function is later defined with incorrect args).")
-
-(defvar byte-compile-tag-number 0)
-(defvar byte-compile-output nil
-  "Alist describing contents to put in byte code string.
-Each element is (INDEX . VALUE)")
-(defvar byte-compile-depth 0 "Current depth of execution stack.")
-(defvar byte-compile-maxdepth 0 "Maximum depth of execution stack.")
-
-
-;;; The byte codes; this information is duplicated in bytecomp.c
-
-(defconst byte-code-vector nil
-  "An array containing byte-code names indexed by byte-code values.")
-
-(defconst byte-stack+-info nil
-  "An array with the stack adjustment for each byte-code.")
-
-(defmacro byte-defop (opcode stack-adjust opname &optional docstring)
-  ;; This is a speed-hack for building the byte-code-vector at compile-time.
-  ;; We fill in the vector at macroexpand-time, and then after the last call
-  ;; to byte-defop, we write the vector out as a constant instead of writing
-  ;; out a bunch of calls to aset.
-  ;; Actually, we don't fill in the vector itself, because that could make
-  ;; it problematic to compile big changes to this compiler; we store the
-  ;; values on its plist, and remove them later in -extrude.
-  (let ((v1 (or (get 'byte-code-vector 'tmp-compile-time-value)
-		(put 'byte-code-vector 'tmp-compile-time-value
-		     (make-vector 256 nil))))
-	(v2 (or (get 'byte-stack+-info 'tmp-compile-time-value)
-		(put 'byte-stack+-info 'tmp-compile-time-value
-		     (make-vector 256 nil)))))
-    (aset v1 opcode opname)
-    (aset v2 opcode stack-adjust))
-  (if docstring
-      (list 'defconst opname opcode (concat "Byte code opcode " docstring "."))
-      (list 'defconst opname opcode)))
-
-(defmacro byte-extrude-byte-code-vectors ()
-  (prog1 (list 'setq 'byte-code-vector
-		     (get 'byte-code-vector 'tmp-compile-time-value)
-		     'byte-stack+-info
-		     (get 'byte-stack+-info 'tmp-compile-time-value))
-    ;; emacs-18 has no REMPROP.
-    (put 'byte-code-vector 'tmp-compile-time-value nil)
-    (put 'byte-stack+-info 'tmp-compile-time-value nil)))
-
-
-;; unused: 0-7
-
-;; These opcodes are special in that they pack their argument into the
-;; opcode word.
-;;
-(byte-defop   8  1 byte-varref	"for variable reference")
-(byte-defop  16 -1 byte-varset	"for setting a variable")
-(byte-defop  24 -1 byte-varbind	"for binding a variable")
-(byte-defop  32  0 byte-call	"for calling a function")
-(byte-defop  40  0 byte-unbind	"for unbinding special bindings")
-;; codes 8-47 are consumed by the preceding opcodes
-
-;; unused: 48-55
-
-(byte-defop  56 -1 byte-nth)
-(byte-defop  57  0 byte-symbolp)
-(byte-defop  58  0 byte-consp)
-(byte-defop  59  0 byte-stringp)
-(byte-defop  60  0 byte-listp)
-(byte-defop  61 -1 byte-eq)
-(byte-defop  62 -1 byte-memq)
-(byte-defop  63  0 byte-not)
-(byte-defop  64  0 byte-car)
-(byte-defop  65  0 byte-cdr)
-(byte-defop  66 -1 byte-cons)
-(byte-defop  67  0 byte-list1)
-(byte-defop  68 -1 byte-list2)
-(byte-defop  69 -2 byte-list3)
-(byte-defop  70 -3 byte-list4)
-(byte-defop  71  0 byte-length)
-(byte-defop  72 -1 byte-aref)
-(byte-defop  73 -2 byte-aset)
-(byte-defop  74  0 byte-symbol-value)
-(byte-defop  75  0 byte-symbol-function) ; this was commented out
-(byte-defop  76 -1 byte-set)
-(byte-defop  77 -1 byte-fset) ; this was commented out
-(byte-defop  78 -1 byte-get)
-(byte-defop  79 -2 byte-substring)
-(byte-defop  80 -1 byte-concat2)
-(byte-defop  81 -2 byte-concat3)
-(byte-defop  82 -3 byte-concat4)
-(byte-defop  83  0 byte-sub1)
-(byte-defop  84  0 byte-add1)
-(byte-defop  85 -1 byte-eqlsign)
-(byte-defop  86 -1 byte-gtr)
-(byte-defop  87 -1 byte-lss)
-(byte-defop  88 -1 byte-leq)
-(byte-defop  89 -1 byte-geq)
-(byte-defop  90 -1 byte-diff)
-(byte-defop  91  0 byte-negate)
-(byte-defop  92 -1 byte-plus)
-(byte-defop  93 -1 byte-max)
-(byte-defop  94 -1 byte-min)
-(byte-defop  95 -1 byte-mult) ; v19 only
-(byte-defop  96  1 byte-point)
-(byte-defop  97  0 byte-save-current-buffer
-  "To make a binding to record the current buffer")
-(byte-defop  98  0 byte-goto-char)
-(byte-defop  99  0 byte-insert)
-(byte-defop 100  1 byte-point-max)
-(byte-defop 101  1 byte-point-min)
-(byte-defop 102  0 byte-char-after)
-(byte-defop 103  1 byte-following-char)
-(byte-defop 104  1 byte-preceding-char)
-(byte-defop 105  1 byte-current-column)
-(byte-defop 106  0 byte-indent-to)
-(byte-defop 107  0 byte-scan-buffer-OBSOLETE) ; no longer generated as of v18
-(byte-defop 108  1 byte-eolp)
-(byte-defop 109  1 byte-eobp)
-(byte-defop 110  1 byte-bolp)
-(byte-defop 111  1 byte-bobp)
-(byte-defop 112  1 byte-current-buffer)
-(byte-defop 113  0 byte-set-buffer)
-(byte-defop 114  1 byte-read-char-OBSOLETE)
-(byte-defop 115  0 byte-set-mark-OBSOLETE)
-(byte-defop 116  1 byte-interactive-p)
-
-;; These ops are new to v19
-(byte-defop 117  0 byte-forward-char)
-(byte-defop 118  0 byte-forward-word)
-(byte-defop 119 -1 byte-skip-chars-forward)
-(byte-defop 120 -1 byte-skip-chars-backward)
-(byte-defop 121  0 byte-forward-line)
-(byte-defop 122  0 byte-char-syntax)
-(byte-defop 123 -1 byte-buffer-substring)
-(byte-defop 124 -1 byte-delete-region)
-(byte-defop 125 -1 byte-narrow-to-region)
-(byte-defop 126  1 byte-widen)
-(byte-defop 127  0 byte-end-of-line)
-
-;; unused: 128
-
-;; These store their argument in the next two bytes
-(byte-defop 129  1 byte-constant2
-   "for reference to a constant with vector index >= byte-constant-limit")
-(byte-defop 130  0 byte-goto "for unconditional jump")
-(byte-defop 131 -1 byte-goto-if-nil "to pop value and jump if it's nil")
-(byte-defop 132 -1 byte-goto-if-not-nil "to pop value and jump if it's not nil")
-(byte-defop 133 -1 byte-goto-if-nil-else-pop
-  "to examine top-of-stack, jump and don't pop it if it's nil, 
-otherwise pop it")
-(byte-defop 134 -1 byte-goto-if-not-nil-else-pop
-  "to examine top-of-stack, jump and don't pop it if it's non nil, 
-otherwise pop it")
-
-(byte-defop 135 -1 byte-return "to pop a value and return it from `byte-code'")
-(byte-defop 136 -1 byte-discard "to discard one value from stack")
-(byte-defop 137  1 byte-dup     "to duplicate the top of the stack")
-
-(byte-defop 138  0 byte-save-excursion
-  "to make a binding to record the buffer, point and mark")
-(byte-defop 139  0 byte-save-window-excursion
-  "to make a binding to record entire window configuration")
-(byte-defop 140  0 byte-save-restriction
-  "to make a binding to record the current buffer clipping restrictions")
-(byte-defop 141 -1 byte-catch
-  "for catch.  Takes, on stack, the tag and an expression for the body")
-(byte-defop 142 -1 byte-unwind-protect
-  "for unwind-protect.  Takes, on stack, an expression for the unwind-action")
-
-;; For condition-case.  Takes, on stack, the variable to bind, 
-;; an expression for the body, and a list of clauses.
-(byte-defop 143 -2 byte-condition-case)
-
-;; For entry to with-output-to-temp-buffer.
-;; Takes, on stack, the buffer name.
-;; Binds standard-output and does some other things.
-;; Returns with temp buffer on the stack in place of buffer name.
-(byte-defop 144  0 byte-temp-output-buffer-setup)
-
-;; For exit from with-output-to-temp-buffer.
-;; Expects the temp buffer on the stack underneath value to return.
-;; Pops them both, then pushes the value back on.
-;; Unbinds standard-output and makes the temp buffer visible.
-(byte-defop 145 -1 byte-temp-output-buffer-show)
-
-;; these ops are new to v19
-
-;; To unbind back to the beginning of this frame.
-;; Not used yet, but will be needed for tail-recursion elimination.
-(byte-defop 146  0 byte-unbind-all)
-
-;; these ops are new to v19
-(byte-defop 147 -2 byte-set-marker)
-(byte-defop 148  0 byte-match-beginning)
-(byte-defop 149  0 byte-match-end)
-(byte-defop 150  0 byte-upcase)
-(byte-defop 151  0 byte-downcase)
-(byte-defop 152 -1 byte-string=)
-(byte-defop 153 -1 byte-string<)
-(byte-defop 154 -1 byte-equal)
-(byte-defop 155 -1 byte-nthcdr)
-(byte-defop 156 -1 byte-elt)
-(byte-defop 157 -1 byte-member)
-(byte-defop 158 -1 byte-assq)
-(byte-defop 159  0 byte-nreverse)
-(byte-defop 160 -1 byte-setcar)
-(byte-defop 161 -1 byte-setcdr)
-(byte-defop 162  0 byte-car-safe)
-(byte-defop 163  0 byte-cdr-safe)
-(byte-defop 164 -1 byte-nconc)
-(byte-defop 165 -1 byte-quo)
-(byte-defop 166 -1 byte-rem)
-(byte-defop 167  0 byte-numberp)
-(byte-defop 168  0 byte-integerp)
-
-;; unused: 169-174
-(byte-defop 175 nil byte-listN)
-(byte-defop 176 nil byte-concatN)
-(byte-defop 177 nil byte-insertN)
-
-;; unused: 178-191
-
-(byte-defop 192  1 byte-constant	"for reference to a constant")
-;; codes 193-255 are consumed by byte-constant.
-(defconst byte-constant-limit 64
-  "Exclusive maximum index usable in the `byte-constant' opcode.")
-
-(defconst byte-goto-ops '(byte-goto byte-goto-if-nil byte-goto-if-not-nil
-			  byte-goto-if-nil-else-pop
-			  byte-goto-if-not-nil-else-pop)
-  "List of byte-codes whose offset is a pc.")
-
-(defconst byte-goto-always-pop-ops '(byte-goto-if-nil byte-goto-if-not-nil))
-
-(byte-extrude-byte-code-vectors)
-
-;;; lapcode generator
-;;;
-;;; the byte-compiler now does source -> lapcode -> bytecode instead of
-;;; source -> bytecode, because it's a lot easier to make optimizations
-;;; on lapcode than on bytecode.
-;;;
-;;; Elements of the lapcode list are of the form (<instruction> . <parameter>)
-;;; where instruction is a symbol naming a byte-code instruction,
-;;; and parameter is an argument to that instruction, if any.
-;;;
-;;; The instruction can be the pseudo-op TAG, which means that this position 
-;;; in the instruction stream is a target of a goto.  (car PARAMETER) will be
-;;; the PC for this location, and the whole instruction "(TAG pc)" will be the
-;;; parameter for some goto op.
-;;;
-;;; If the operation is varbind, varref, varset or push-constant, then the
-;;; parameter is (variable/constant . index_in_constant_vector).
-;;;
-;;; First, the source code is macroexpanded and optimized in various ways.
-;;; Then the resultant code is compiled into lapcode.  Another set of
-;;; optimizations are then run over the lapcode.  Then the variables and
-;;; constants referenced by the lapcode are collected and placed in the
-;;; constants-vector.  (This happens now so that variables referenced by dead
-;;; code don't consume space.)  And finally, the lapcode is transformed into
-;;; compacted byte-code.
-;;;
-;;; A distinction is made between variables and constants because the variable-
-;;; referencing instructions are more sensitive to the variables being near the
-;;; front of the constants-vector than the constant-referencing instructions.
-;;; Also, this lets us notice references to free variables.
-
-(defun byte-compile-lapcode (lap)
-  "Turns lapcode into bytecode.  The lapcode is destroyed."
-  ;; Lapcode modifications: changes the ID of a tag to be the tag's PC.
-  (let ((pc 0)			; Program counter
-	op off			; Operation & offset
-	(bytes '())		; Put the output bytes here
-	(patchlist nil)		; List of tags and goto's to patch
-	rest rel tmp)
-    (while lap
-      (setq op (car (car lap))
-	    off (cdr (car lap)))
-      (cond ((not (symbolp op))
-	     (error "Non-symbolic opcode `%s'" op))
-	    ((eq op 'TAG)
-	     (setcar off pc)
-	     (setq patchlist (cons off patchlist)))
-	    ((memq op byte-goto-ops)
-	     (setq pc (+ pc 3))
-	     (setq bytes (cons (cons pc (cdr off))
-			       (cons nil
-				     (cons (symbol-value op) bytes))))
-	     (setq patchlist (cons bytes patchlist)))
-	    (t
-	     (setq bytes
-		   (cond ((cond ((consp off)
-				 ;; Variable or constant reference
-				 (setq off (cdr off))
-				 (eq op 'byte-constant)))
-			  (cond ((< off byte-constant-limit)
-				 (setq pc (1+ pc))
-				 (cons (+ byte-constant off) bytes))
-				(t
-				 (setq pc (+ 3 pc))
-				 (cons (lsh off -8)
-				       (cons (logand off 255)
-					     (cons byte-constant2 bytes))))))
-			 ((<= byte-listN (symbol-value op))
-			  (setq pc (+ 2 pc))
-			  (cons off (cons (symbol-value op) bytes)))
-			 ((< off 6)
-			  (setq pc (1+ pc))
-			  (cons (+ (symbol-value op) off) bytes))
-			 ((< off 256)
-			  (setq pc (+ 2 pc))
-			  (cons off (cons (+ (symbol-value op) 6) bytes)))
-			 (t
-			  (setq pc (+ 3 pc))
-			  (cons (lsh off -8)
-				(cons (logand off 255)
-				      (cons (+ (symbol-value op) 7)
-					    bytes))))))))
-      (setq lap (cdr lap)))
-    ;;(if (not (= pc (length bytes)))
-    ;;    (error "Compiler error: pc mismatch - %s %s" pc (length bytes)))
-    ;; Patch PC into jumps
-    (let (bytes)
-      (while patchlist
-	(setq bytes (car patchlist))
-	(cond ((atom (car bytes)))	; Tag
-	      (t			; Absolute jump
-	       (setq pc (car (cdr (car bytes))))	; Pick PC from tag
-	       (setcar (cdr bytes) (logand pc 255))
-	       (setcar bytes (lsh pc -8))))
-	(setq patchlist (cdr patchlist))))
-    (concat (nreverse bytes))))
-
-
-;;; byte compiler messages
-
-(defvar byte-compile-current-form nil)
-(defvar byte-compile-current-file nil)
-(defvar byte-compile-dest-file nil)
-
-(defmacro byte-compile-log (format-string &rest args)
-  (list 'and
-	'byte-optimize
-	'(memq byte-optimize-log '(t source))
-	(list 'let '((print-escape-newlines t)
-		     (print-level 4)
-		     (print-length 4))
-	      (list 'byte-compile-log-1
-		    (cons 'format
-		      (cons format-string
-			(mapcar
-			 '(lambda (x)
-			    (if (symbolp x) (list 'prin1-to-string x) x))
-			 args)))))))
-
-(defconst byte-compile-last-warned-form nil)
-
-;; Log a message STRING in *Compile-Log*.
-;; Also log the current function and file if not already done.
-(defun byte-compile-log-1 (string &optional fill)
-  (cond (noninteractive
-	 (if (or byte-compile-current-file
-		 (and byte-compile-last-warned-form
-		      (not (eq byte-compile-current-form
-			       byte-compile-last-warned-form))))
-	     (message "While compiling %s%s:"
-		      (or byte-compile-current-form "toplevel forms")
-		      (if byte-compile-current-file
-			  (if (stringp byte-compile-current-file)
-			      (concat " in file " byte-compile-current-file)
-			    (concat " in buffer "
-				    (buffer-name byte-compile-current-file)))
-			"")))
-	 (message "  %s" string))
-	(t
-	 (save-excursion
-	   (set-buffer (get-buffer-create "*Compile-Log*"))
-	   (goto-char (point-max))
-	   (cond ((or byte-compile-current-file
-		      (and byte-compile-last-warned-form
-			   (not (eq byte-compile-current-form
-				    byte-compile-last-warned-form))))
-		  (if byte-compile-current-file
-		      (insert "\n\^L\n" (current-time-string) "\n"))
-		  (insert "While compiling "
-			  (if byte-compile-current-form
-			      (format "%s" byte-compile-current-form)
-			    "toplevel forms"))
-		  (if byte-compile-current-file
-		      (if (stringp byte-compile-current-file)
-			  (insert " in file " byte-compile-current-file)
-			(insert " in buffer "
-				(buffer-name byte-compile-current-file))))
-		  (insert ":\n")))
-	   (insert "  " string "\n")
-	   (if (and fill (not (string-match "\n" string)))
-	       (let ((fill-prefix "     ")
-		     (fill-column 78))
-		 (fill-paragraph nil)))
-	   )))
-  (setq byte-compile-current-file nil
-	byte-compile-last-warned-form byte-compile-current-form))
-
-;; Log the start of a file in *Compile-Log*, and mark it as done.
-;; But do nothing in batch mode.
-(defun byte-compile-log-file ()
-  (and byte-compile-current-file (not noninteractive)
-       (save-excursion
-	 (set-buffer (get-buffer-create "*Compile-Log*"))
-	 (goto-char (point-max))
-	 (insert "\n\^L\nCompiling "
-		 (if (stringp byte-compile-current-file)
-		     (concat "file " byte-compile-current-file)
-		   (concat "buffer " (buffer-name byte-compile-current-file)))
-		 " at " (current-time-string) "\n")
-	 (setq byte-compile-current-file nil))))
-
-(defun byte-compile-warn (format &rest args)
-  (setq format (apply 'format format args))
-  (if byte-compile-error-on-warn
-      (error "%s" format)		; byte-compile-file catches and logs it
-    (byte-compile-log-1 (concat "** " format) t)
-;;; It is useless to flash warnings too fast to be read.
-;;; Besides, they will all be shown at the end.
-;;;    (or noninteractive  ; already written on stdout.
-;;;	(message "Warning: %s" format))
-    ))
-
-;;; This function should be used to report errors that have halted
-;;; compilation of the current file.
-(defun byte-compile-report-error (error-info)
-  (setq byte-compiler-error-flag t)
-  (byte-compile-log-1
-   (concat "!! "
-	   (format (if (cdr error-info) "%s (%s)" "%s")
-		   (get (car error-info) 'error-message)
-		   (prin1-to-string (cdr error-info))))))
-
-;;; Used by make-obsolete.
-(defun byte-compile-obsolete (form)
-  (let ((new (get (car form) 'byte-obsolete-info)))
-    (if (memq 'obsolete byte-compile-warnings)
-	(byte-compile-warn "%s is an obsolete function; %s" (car form)
-			   (if (stringp (car new))
-			       (car new)
-			       (format "use %s instead." (car new)))))
-    (funcall (or (cdr new) 'byte-compile-normal-call) form)))
-
-;; Compiler options
-
-;; (defvar byte-compiler-valid-options
-;;   '((optimize byte-optimize (t nil source byte) val)
-;;     (file-format byte-compile-compatibility (emacs18 emacs19)
-;; 		 (eq val 'emacs18))
-;; ;;     (new-bytecodes byte-compile-generate-emacs19-bytecodes (t nil) val)
-;;     (delete-errors byte-compile-delete-errors (t nil) val)
-;;     (verbose byte-compile-verbose (t nil) val)
-;;     (warnings byte-compile-warnings ((callargs redefine free-vars unresolved))
-;; 	      val)))
-
-;; Inhibit v18/v19 selectors if the version is hardcoded.
-;; #### This should print a warning if the user tries to change something 
-;; than can't be changed because the running compiler doesn't support it.
-;; (cond
-;;  ((byte-compile-single-version)
-;;   (setcar (cdr (cdr (assq 'new-bytecodes byte-compiler-valid-options)))
-;; 	  (list (byte-compile-version-cond
-;; 		 byte-compile-generate-emacs19-bytecodes)))
-;;   (setcar (cdr (cdr (assq 'file-format byte-compiler-valid-options)))
-;; 	  (if (byte-compile-version-cond byte-compile-compatibility)
-;; 	      '(emacs18) '(emacs19)))))
-
-;; (defun byte-compiler-options-handler (&rest args)
-;;   (let (key val desc choices)
-;;     (while args
-;;       (if (or (atom (car args)) (nthcdr 2 (car args)) (null (cdr (car args))))
-;; 	  (error "Malformed byte-compiler option `%s'" (car args)))
-;;       (setq key (car (car args))
-;; 	    val (car (cdr (car args)))
-;; 	    desc (assq key byte-compiler-valid-options))
-;;       (or desc
-;; 	  (error "Unknown byte-compiler option `%s'" key))
-;;       (setq choices (nth 2 desc))
-;;       (if (consp (car choices))
-;; 	  (let (this
-;; 		(handler 'cons)
-;; 		(ret (and (memq (car val) '(+ -))
-;; 			  (copy-sequence (if (eq t (symbol-value (nth 1 desc)))
-;; 					     choices
-;; 					   (symbol-value (nth 1 desc)))))))
-;; 	    (setq choices (car  choices))
-;; 	    (while val
-;; 	      (setq this (car val))
-;; 	      (cond ((memq this choices)
-;; 		     (setq ret (funcall handler this ret)))
-;; 		    ((eq this '+) (setq handler 'cons))
-;; 		    ((eq this '-) (setq handler 'delq))
-;; 		    ((error "`%s' only accepts %s" key choices)))
-;; 	      (setq val (cdr val)))
-;; 	    (set (nth 1 desc) ret))
-;; 	(or (memq val choices)
-;; 	    (error "`%s' must be one of `%s'" key choices))
-;; 	(set (nth 1 desc) (eval (nth 3 desc))))
-;;       (setq args (cdr args)))
-;;     nil))
-
-;;; sanity-checking arglists
-
-(defun byte-compile-fdefinition (name macro-p)
-  (let* ((list (if macro-p
-		   byte-compile-macro-environment
-		 byte-compile-function-environment))
-	 (env (cdr (assq name list))))
-    (or env
-	(let ((fn name))
-	  (while (and (symbolp fn)
-		      (fboundp fn)
-		      (or (symbolp (symbol-function fn))
-			  (consp (symbol-function fn))
-			  (and (not macro-p)
-			       (byte-code-function-p (symbol-function fn)))))
-	    (setq fn (symbol-function fn)))
-	  (if (and (not macro-p) (byte-code-function-p fn))
-	      fn
-	    (and (consp fn)
-		 (if (eq 'macro (car fn))
-		     (cdr fn)
-		   (if macro-p
-		       nil
-		     (if (eq 'autoload (car fn))
-			 nil
-		       fn)))))))))
-
-(defun byte-compile-arglist-signature (arglist)
-  (let ((args 0)
-	opts
-	restp)
-    (while arglist
-      (cond ((eq (car arglist) '&optional)
-	     (or opts (setq opts 0)))
-	    ((eq (car arglist) '&rest)
-	     (if (cdr arglist)
-		 (setq restp t
-		       arglist nil)))
-	    (t
-	     (if opts
-		 (setq opts (1+ opts))
-		 (setq args (1+ args)))))
-      (setq arglist (cdr arglist)))
-    (cons args (if restp nil (if opts (+ args opts) args)))))
-
-
-(defun byte-compile-arglist-signatures-congruent-p (old new)
-  (not (or
-	 (> (car new) (car old))  ; requires more args now
-	 (and (null (cdr old))    ; took rest-args, doesn't any more
-	      (cdr new))
-	 (and (cdr new) (cdr old) ; can't take as many args now
-	      (< (cdr new) (cdr old)))
-	 )))
-
-(defun byte-compile-arglist-signature-string (signature)
-  (cond ((null (cdr signature))
-	 (format "%d+" (car signature)))
-	((= (car signature) (cdr signature))
-	 (format "%d" (car signature)))
-	(t (format "%d-%d" (car signature) (cdr signature)))))
-
-
-;; Warn if the form is calling a function with the wrong number of arguments.
-(defun byte-compile-callargs-warn (form)
-  (let* ((def (or (byte-compile-fdefinition (car form) nil)
-		  (byte-compile-fdefinition (car form) t)))
-	 (sig (and def (byte-compile-arglist-signature
-			 (if (eq 'lambda (car-safe def))
-			     (nth 1 def)
-			   (if (byte-code-function-p def)
-			       (aref def 0)
-			     '(&rest def))))))
-	 (ncall (length (cdr form))))
-    (if sig
-	(if (or (< ncall (car sig))
-		(and (cdr sig) (> ncall (cdr sig))))
-	    (byte-compile-warn
-	      "%s called with %d argument%s, but %s %s"
-	      (car form) ncall
-	      (if (= 1 ncall) "" "s")
-	      (if (< ncall (car sig))
-		  "requires"
-		  "accepts only")
-	      (byte-compile-arglist-signature-string sig)))
-      (or (fboundp (car form)) ; might be a subr or autoload.
-	  (eq (car form) byte-compile-current-form) ; ## this doesn't work with recursion.
-	  ;; It's a currently-undefined function.  Remember number of args in call.
-	  (let ((cons (assq (car form) byte-compile-unresolved-functions))
-		(n (length (cdr form))))
-	    (if cons
-		(or (memq n (cdr cons))
-		    (setcdr cons (cons n (cdr cons))))
-		(setq byte-compile-unresolved-functions
-		      (cons (list (car form) n)
-			    byte-compile-unresolved-functions))))))))
-
-;; Warn if the function or macro is being redefined with a different
-;; number of arguments.
-(defun byte-compile-arglist-warn (form macrop)
-  (let ((old (byte-compile-fdefinition (nth 1 form) macrop)))
-    (if old
-	(let ((sig1 (byte-compile-arglist-signature
-		      (if (eq 'lambda (car-safe old))
-			  (nth 1 old)
-			(if (byte-code-function-p old)
-			    (aref old 0)
-			  '(&rest def)))))
-	      (sig2 (byte-compile-arglist-signature (nth 2 form))))
-	  (or (byte-compile-arglist-signatures-congruent-p sig1 sig2)
-	      (byte-compile-warn "%s %s used to take %s %s, now takes %s"
-		(if (eq (car form) 'defun) "function" "macro")
-		(nth 1 form)
-		(byte-compile-arglist-signature-string sig1)
-		(if (equal sig1 '(1 . 1)) "argument" "arguments")
-		(byte-compile-arglist-signature-string sig2))))
-      ;; This is the first definition.  See if previous calls are compatible.
-      (let ((calls (assq (nth 1 form) byte-compile-unresolved-functions))
-	    nums sig min max)
-	(if calls
-	    (progn
-	      (setq sig (byte-compile-arglist-signature (nth 2 form))
-		    nums (sort (copy-sequence (cdr calls)) (function <))
-		    min (car nums)
-		    max (car (nreverse nums)))
-	      (if (or (< min (car sig))
-		      (and (cdr sig) (> max (cdr sig))))
-		  (byte-compile-warn
-	    "%s being defined to take %s%s, but was previously called with %s"
-	            (nth 1 form)
-		    (byte-compile-arglist-signature-string sig)
-		    (if (equal sig '(1 . 1)) " arg" " args")
-		    (byte-compile-arglist-signature-string (cons min max))))
-	      
-	      (setq byte-compile-unresolved-functions
-		    (delq calls byte-compile-unresolved-functions)))))
-      )))
-
-;; If we have compiled any calls to functions which are not known to be 
-;; defined, issue a warning enumerating them.
-;; `unresolved' in the list `byte-compile-warnings' disables this.
-(defun byte-compile-warn-about-unresolved-functions ()
-  (if (memq 'unresolved byte-compile-warnings)
-   (let ((byte-compile-current-form "the end of the data"))
-    (if (cdr byte-compile-unresolved-functions)
-	(let* ((str "The following functions are not known to be defined: ")
-	       (L (length str))
-	       (rest (reverse byte-compile-unresolved-functions))
-	       s)
-	  (while rest
-	    (setq s (symbol-name (car (car rest)))
-		  L (+ L (length s) 2)
-		  rest (cdr rest))
-	    (if (< L (1- fill-column))
-		(setq str (concat str " " s (and rest ",")))
-	      (setq str (concat str "\n    " s (and rest ","))
-		    L (+ (length s) 4))))
-	  (byte-compile-warn "%s" str))
-	(if byte-compile-unresolved-functions
-	    (byte-compile-warn "the function %s is not known to be defined."
-	      (car (car byte-compile-unresolved-functions)))))))
-  nil)
-
-
-(defmacro byte-compile-constp (form)
-  ;; Returns non-nil if FORM is a constant.
-  (` (cond ((consp (, form)) (eq (car (, form)) 'quote))
-	   ((not (symbolp (, form))))
-	   ((memq (, form) '(nil t))))))
-
-(defmacro byte-compile-close-variables (&rest body)
-  (cons 'let
-	(cons '(;;
-		;; Close over these variables to encapsulate the
-		;; compilation state
-		;;
-		(byte-compile-macro-environment
-		 ;; Copy it because the compiler may patch into the
-		 ;; macroenvironment.
-		 (copy-alist byte-compile-initial-macro-environment))
-		(byte-compile-function-environment nil)
-		(byte-compile-bound-variables nil)
-		(byte-compile-free-references nil)
-		(byte-compile-free-assignments nil)
-		;;
-		;; Close over these variables so that `byte-compiler-options'
-		;; can change them on a per-file basis.
-		;;
-		(byte-compile-verbose byte-compile-verbose)
-		(byte-optimize byte-optimize)
-		(byte-compile-compatibility byte-compile-compatibility)
-		(byte-compile-dynamic byte-compile-dynamic)
-		(byte-compile-dynamic-docstrings
-		 byte-compile-dynamic-docstrings)
-;; 		(byte-compile-generate-emacs19-bytecodes
-;; 		 byte-compile-generate-emacs19-bytecodes)
-		(byte-compile-warnings (if (eq byte-compile-warnings t)
-					   byte-compile-warning-types
-					 byte-compile-warnings))
-		)
-	      body)))
-
-(defvar byte-compile-warnings-point-max nil)
-(defmacro displaying-byte-compile-warnings (&rest body)
-  (list 'let
-	'((byte-compile-warnings-point-max byte-compile-warnings-point-max))
-     ;; Log the file name.
-     '(byte-compile-log-file)
-     ;; Record how much is logged now.
-     ;; We will display the log buffer if anything more is logged
-     ;; before the end of BODY.
-     '(or byte-compile-warnings-point-max
-	  (save-excursion
-	    (set-buffer (get-buffer-create "*Compile-Log*"))
-	    (setq byte-compile-warnings-point-max (point-max))))
-     (list 'unwind-protect
-	   (list 'condition-case 'error-info
-		 (cons 'progn body)
-	       '(error
-		 (byte-compile-report-error error-info)))
-       '(save-excursion
-	  ;; If there were compilation warnings, display them.
-	  (set-buffer "*Compile-Log*")
-	  (if (= byte-compile-warnings-point-max (point-max))
-	      nil
-	    (select-window
-	     (prog1 (selected-window)
-	       (select-window (display-buffer (current-buffer)))
-	       (goto-char byte-compile-warnings-point-max)
-	       (recenter 1))))))))
-
-
-;;;###autoload
-(defun byte-force-recompile (directory)
-  "Recompile every `.el' file in DIRECTORY that already has a `.elc' file.
-Files in subdirectories of DIRECTORY are processed also."
-  (interactive "DByte force recompile (directory): ")
-  (byte-recompile-directory directory nil t))
-
-;;;###autoload
-(defun byte-recompile-directory (directory &optional arg force)
-  "Recompile every `.el' file in DIRECTORY that needs recompilation.
-This is if a `.elc' file exists but is older than the `.el' file.
-Files in subdirectories of DIRECTORY are processed also.
-
-If the `.elc' file does not exist, normally the `.el' file is *not* compiled.
-But a prefix argument (optional second arg) means ask user,
-for each such `.el' file, whether to compile it.  Prefix argument 0 means
-don't ask and compile the file anyway.
-
-A nonzero prefix argument also means ask about each subdirectory.
-
-If the third argument FORCE is non-nil,
-recompile every `.el' file that already has a `.elc' file."
-  (interactive "DByte recompile directory: \nP")
-  (if arg
-      (setq arg (prefix-numeric-value arg)))
-  (if noninteractive
-      nil
-    (save-some-buffers)
-    (force-mode-line-update))
-  (let ((directories (list (expand-file-name directory)))
-	(file-count 0)
-	(dir-count 0)
-	last-dir)
-    (displaying-byte-compile-warnings
-     (while directories
-       (setq directory (car directories))
-       (or noninteractive (message "Checking %s..." directory))
-       (let ((files (directory-files directory))
-	     source dest)
-	 (while files
-	   (setq source (expand-file-name (car files) directory))
-	   (if (and (not (member (car files) '("." ".." "RCS" "CVS")))
-		    (file-directory-p source)
-		    (not (file-symlink-p source)))
-	       ;; This file is a subdirectory.  Handle them differently.
-	       (if (or (null arg)
-		       (eq 0 arg)
-		       (y-or-n-p (concat "Check " source "? ")))
-		   (setq directories
-			 (nconc directories (list source))))
-	     ;; It is an ordinary file.  Decide whether to compile it.
-	     (if (and (string-match emacs-lisp-file-regexp source)
-		      (not (auto-save-file-name-p source))
-		      (setq dest (byte-compile-dest-file source))
-		      (if (file-exists-p dest)
-			  ;; File was already compiled.
-			  (or force (file-newer-than-file-p source dest))
-			;; No compiled file exists yet.
-			(and arg
-			     (or (eq 0 arg)
-				 (y-or-n-p (concat "Compile " source "? "))))))
-		 (progn (if (and noninteractive (not byte-compile-verbose))
-			    (message "Compiling %s..." source))
-			(byte-compile-file source)
-			(or noninteractive
-			    (message "Checking %s..." directory))
-			(setq file-count (1+ file-count))
-			(if (not (eq last-dir directory))
-			    (setq last-dir directory
-				  dir-count (1+ dir-count)))
-			)))
-	   (setq files (cdr files))))
-       (setq directories (cdr directories))))
-    (message "Done (Total of %d file%s compiled%s)"
-	     file-count (if (= file-count 1) "" "s")
-	     (if (> dir-count 1) (format " in %d directories" dir-count) ""))))
-
-;;;###autoload
-(defun byte-compile-file (filename &optional load)
-  "Compile a file of Lisp code named FILENAME into a file of byte code.
-The output file's name is made by appending `c' to the end of FILENAME.
-With prefix arg (noninteractively: 2nd arg), load the file after compiling."
-;;  (interactive "fByte compile file: \nP")
-  (interactive
-   (let ((file buffer-file-name)
-	 (file-name nil)
-	 (file-dir nil))
-     (and file
-	  (eq (cdr (assq 'major-mode (buffer-local-variables)))
-	      'emacs-lisp-mode)
-	  (setq file-name (file-name-nondirectory file)
-		file-dir (file-name-directory file)))
-     (list (read-file-name (if current-prefix-arg
-			       "Byte compile and load file: "
-			     "Byte compile file: ")
-			   file-dir file-name nil)
-	   current-prefix-arg)))
-  ;; Expand now so we get the current buffer's defaults
-  (setq filename (expand-file-name filename))
-
-  ;; If we're compiling a file that's in a buffer and is modified, offer
-  ;; to save it first.
-  (or noninteractive
-      (let ((b (get-file-buffer (expand-file-name filename))))
-	(if (and b (buffer-modified-p b)
-		 (y-or-n-p (format "save buffer %s first? " (buffer-name b))))
-	    (save-excursion (set-buffer b) (save-buffer)))))
-
-  (if byte-compile-verbose
-      (message "Compiling %s..." filename))
-  (let ((byte-compile-current-file filename)
-	target-file input-buffer output-buffer
-	byte-compile-dest-file)
-    (setq target-file (byte-compile-dest-file filename))
-    (setq byte-compile-dest-file target-file)
-    (save-excursion
-      (setq input-buffer (get-buffer-create " *Compiler Input*"))
-      (set-buffer input-buffer)
-      (erase-buffer)
-      (insert-file-contents filename)
-      ;; Run hooks including the uncompression hook.
-      ;; If they change the file name, then change it for the output also.
-      (let ((buffer-file-name filename)
-	    (default-major-mode 'emacs-lisp-mode)
-	    (enable-local-eval nil))
-        (normal-mode)
-        (setq filename buffer-file-name))
-      ;; Set the default directory, in case an eval-when-compile uses it.
-      (setq default-directory (file-name-directory filename)))
-    (setq byte-compiler-error-flag nil)
-    ;; It is important that input-buffer not be current at this call,
-    ;; so that the value of point set in input-buffer
-    ;; within byte-compile-from-buffer lingers in that buffer.
-    (setq output-buffer (byte-compile-from-buffer input-buffer filename))
-    (if byte-compiler-error-flag
-	nil
-      (if byte-compile-verbose
-	  (message "Compiling %s...done" filename))
-      (kill-buffer input-buffer)
-      (save-excursion
-	(set-buffer output-buffer)
-	(goto-char (point-max))
-	(insert "\n")			; aaah, unix.
-	(let ((vms-stmlf-recfm t))
-	  (if (file-writable-p target-file)
-	      (let ((kanji-flag nil))	; for nemacs, from Nakagawa Takayuki
-		(if (or (eq system-type 'ms-dos) (eq system-type 'windows-nt))
-		    (setq buffer-file-type t))
-		(write-region 1 (point-max) target-file))
-	    ;; This is just to give a better error message than
-	    ;; write-region
-	    (signal 'file-error
-		    (list "Opening output file"
-			  (if (file-exists-p target-file)
-			      "cannot overwrite file"
-			    "directory not writable or nonexistent")
-			  target-file))))
-	(kill-buffer (current-buffer)))
-      (if (and byte-compile-generate-call-tree
-	       (or (eq t byte-compile-generate-call-tree)
-		   (y-or-n-p (format "Report call tree for %s? " filename))))
-	  (save-excursion
-	    (display-call-tree filename)))
-      (if load
-	  (load target-file))
-      t)))
-
-;;(defun byte-compile-and-load-file (&optional filename)
-;;  "Compile a file of Lisp code named FILENAME into a file of byte code,
-;;and then load it.  The output file's name is made by appending \"c\" to 
-;;the end of FILENAME."
-;;  (interactive)
-;;  (if filename ; I don't get it, (interactive-p) doesn't always work
-;;      (byte-compile-file filename t)
-;;    (let ((current-prefix-arg '(4)))
-;;      (call-interactively 'byte-compile-file))))
-
-;;(defun byte-compile-buffer (&optional buffer)
-;;  "Byte-compile and evaluate contents of BUFFER (default: the current buffer)."
-;;  (interactive "bByte compile buffer: ")
-;;  (setq buffer (if buffer (get-buffer buffer) (current-buffer)))
-;;  (message "Compiling %s..." (buffer-name buffer))
-;;  (let* ((filename (or (buffer-file-name buffer)
-;;		       (concat "#<buffer " (buffer-name buffer) ">")))
-;;	 (byte-compile-current-file buffer))
-;;    (byte-compile-from-buffer buffer nil))
-;;  (message "Compiling %s...done" (buffer-name buffer))
-;;  t)
-
-;;; compiling a single function
-;;;###autoload
-(defun compile-defun (&optional arg)
-  "Compile and evaluate the current top-level form.
-Print the result in the minibuffer.
-With argument, insert value in current buffer after the form."
-  (interactive "P")
-  (save-excursion
-    (end-of-defun)
-    (beginning-of-defun)
-    (let* ((byte-compile-current-file nil)
-	   (byte-compile-last-warned-form 'nothing)
-	   (value (eval (displaying-byte-compile-warnings
-			 (byte-compile-sexp (read (current-buffer)))))))
-      (cond (arg
-	     (message "Compiling from buffer... done.")
-	     (prin1 value (current-buffer))
-	     (insert "\n"))
-	    ((message "%s" (prin1-to-string value)))))))
-
-
-(defun byte-compile-from-buffer (inbuffer &optional filename)
-  ;; Filename is used for the loading-into-Emacs-18 error message.
-  (let (outbuffer
-	;; Prevent truncation of flonums and lists as we read and print them
-	(float-output-format nil)
-	(case-fold-search nil)
-	(print-length nil)
-	(print-level nil)
-	;; Simulate entry to byte-compile-top-level
-	(byte-compile-constants nil)
-	(byte-compile-variables nil)
-	(byte-compile-tag-number 0)
-	(byte-compile-depth 0)
-	(byte-compile-maxdepth 0)
-	(byte-compile-output nil)
-	;;	  #### This is bound in b-c-close-variables.
-	;;	  (byte-compile-warnings (if (eq byte-compile-warnings t)
-	;;				     byte-compile-warning-types
-	;;				   byte-compile-warnings))
-	)
-    (byte-compile-close-variables
-     (save-excursion
-       (setq outbuffer
-	     (set-buffer (get-buffer-create " *Compiler Output*")))
-       (erase-buffer)
-       ;;	 (emacs-lisp-mode)
-       (setq case-fold-search nil)
-       (and filename (byte-compile-insert-header filename inbuffer outbuffer))
-
-       ;; This is a kludge.  Some operating systems (OS/2, DOS) need to
-       ;; write files containing binary information specially.
-       ;; Under most circumstances, such files will be in binary
-       ;; overwrite mode, so those OS's use that flag to guess how
-       ;; they should write their data.  Advise them that .elc files
-       ;; need to be written carefully.
-       (setq overwrite-mode 'overwrite-mode-binary))
-     (displaying-byte-compile-warnings
-      (save-excursion
-	(set-buffer inbuffer)
-	(goto-char 1)
-
-	;; Compile the forms from the input buffer.
-	(while (progn
-		 (while (progn (skip-chars-forward " \t\n\^l")
-			       (looking-at ";"))
-		   (forward-line 1))
-		 (not (eobp)))
-	  (byte-compile-file-form (read inbuffer)))
-
-	;; Compile pending forms at end of file.
-	(byte-compile-flush-pending)
-	(byte-compile-warn-about-unresolved-functions)
-	;; Should we always do this?  When calling multiple files, it
-	;; would be useful to delay this warning until all have
-	;; been compiled.
-	(setq byte-compile-unresolved-functions nil))))
-    outbuffer))
-
-(defun byte-compile-insert-header (filename inbuffer outbuffer)
-  (set-buffer inbuffer)
-  (let ((dynamic-docstrings byte-compile-dynamic-docstrings)
-	(dynamic byte-compile-dynamic))
-    (set-buffer outbuffer)
-    (goto-char 1)
-    ;;
-    ;; The magic number of .elc files is ";ELC", or 0x3B454C43.  After that is
-    ;; the file-format version number (18 or 19) as a byte, followed by some
-    ;; nulls.  The primary motivation for doing this is to get some binary
-    ;; characters up in the first line of the file so that `diff' will simply
-    ;; say "Binary files differ" instead of actually doing a diff of two .elc
-    ;; files.  An extra benefit is that you can add this to /etc/magic:
-    ;;
-    ;; 0	string		;ELC		GNU Emacs Lisp compiled file,
-    ;; >4	byte		x		version %d
-    ;;
-    (insert
-     ";ELC"
-     (if (byte-compile-version-cond byte-compile-compatibility) 18 19)
-     "\000\000\000\n"
-     )
-    (insert ";;; Compiled by "
-	    (or (and (boundp 'user-mail-address) user-mail-address)
-		(concat (user-login-name) "@" (system-name)))
-	    " on "
-	    (current-time-string) "\n;;; from file " filename "\n")
-    (insert ";;; in Emacs version " emacs-version "\n")
-    (insert ";;; with bytecomp version "
-	    (progn (string-match "[0-9.]+" byte-compile-version)
-		   (match-string 0 byte-compile-version))
-	    "\n;;; "
-	    (cond
-	     ((eq byte-optimize 'source) "with source-level optimization only")
-	     ((eq byte-optimize 'byte) "with byte-level optimization only")
-	     (byte-optimize "with all optimizations")
-	     (t "without optimization"))
-	    (if (byte-compile-version-cond byte-compile-compatibility)
-		"; compiled with Emacs 18 compatibility.\n"
-	      ".\n"))
-    (if dynamic
-	(insert ";;; Function definitions are lazy-loaded.\n"))
-    (if (not (byte-compile-version-cond byte-compile-compatibility))
-	(insert ";;; This file uses opcodes which do not exist in Emacs 18.\n"
-		;; Have to check if emacs-version is bound so that this works
-		;; in files loaded early in loadup.el.
-		"\n(if (and (boundp 'emacs-version)\n"
-		;; If there is a name at the end of emacs-version,
-		;; don't try to check the version number.
-		"\t (< (aref emacs-version (1- (length emacs-version))) ?A)\n"
-		"\t (or (and (boundp 'epoch::version) epoch::version)\n"
-		(if dynamic-docstrings
-		    "\t     (string-lessp emacs-version \"19.29\")))\n"
-		  "\t     (string-lessp emacs-version \"19\")))\n")
-		"    (error \"`"
-		;; prin1-to-string is used to quote backslashes.
-		(substring (prin1-to-string (file-name-nondirectory filename))
-			   1 -1)
-		(if dynamic-docstrings
-		    "' was compiled for Emacs 19.29 or later\"))\n\n"
-		  "' was compiled for Emacs 19\"))\n\n"))
-      (insert "(or (boundp 'current-load-list) (setq current-load-list nil))\n"
-	      "\n")
-      )))
-
-
-(defun byte-compile-output-file-form (form)
-  ;; writes the given form to the output buffer, being careful of docstrings
-  ;; in defun, defmacro, defvar, defconst and autoload because make-docfile is
-  ;; so amazingly stupid.
-  ;; defalias calls are output directly by byte-compile-file-form-defmumble;
-  ;; it does not pay to first build the defalias in defmumble and then parse
-  ;; it here.
-  (if (and (memq (car-safe form) '(defun defmacro defvar defconst autoload))
-	   (stringp (nth 3 form)))
-      (byte-compile-output-docform nil nil '("\n(" 3 ")") form nil
-				   (eq (car form) 'autoload))
-    (let ((print-escape-newlines t)
-	  (print-length nil)
-	  (print-level nil)
-	  (print-quoted t)
-	  (print-gensym t))
-      (princ "\n" outbuffer)
-      (prin1 form outbuffer)
-      nil)))
-
-(defun byte-compile-output-docform (preface name info form specindex quoted)
-  "Print a form with a doc string.  INFO is (prefix doc-index postfix).
-If PREFACE and NAME are non-nil, print them too,
-before INFO and the FORM but after the doc string itself.
-If SPECINDEX is non-nil, it is the index in FORM
-of the function bytecode string.  In that case,
-we output that argument and the following argument (the constants vector)
-together, for lazy loading.
-QUOTED says that we have to put a quote before the
-list that represents a doc string reference.
-`autoload' needs that."
-  ;; We need to examine byte-compile-dynamic-docstrings
-  ;; in the input buffer (now current), not in the output buffer.
-  (let ((dynamic-docstrings byte-compile-dynamic-docstrings))
-    (set-buffer
-     (prog1 (current-buffer)
-       (set-buffer outbuffer)
-       (let (position)
-
-	 ;; Insert the doc string, and make it a comment with #@LENGTH.
-	 (and (>= (nth 1 info) 0)
-	      dynamic-docstrings
-	      (not byte-compile-compatibility)
-	      (progn
-		;; Make the doc string start at beginning of line
-		;; for make-docfile's sake.
-		(insert "\n")
-		(setq position
-		      (byte-compile-output-as-comment
-		       (nth (nth 1 info) form) nil))
-		;; If the doc string starts with * (a user variable),
-		;; negate POSITION.
-		(if (and (stringp (nth (nth 1 info) form))
-			 (> (length (nth (nth 1 info) form)) 0)
-			 (eq (aref (nth (nth 1 info) form) 0) ?*))
-		    (setq position (- position)))))
-
-	 (if preface
-	     (progn
-	       (insert preface)
-	       (prin1 name outbuffer)))
-	 (insert (car info))
-	 (let ((print-escape-newlines t)
-	       (print-quoted t)
-	       (print-gensym t)
-	       (index 0))
-	   (prin1 (car form) outbuffer)
-	   (while (setq form (cdr form))
-	     (setq index (1+ index))
-	     (insert " ")
-	     (cond ((and (numberp specindex) (= index specindex))
-		    (let ((position
-			   (byte-compile-output-as-comment
-			    (cons (car form) (nth 1 form))
-			    t)))
-		      (princ (format "(#$ . %d) nil" position) outbuffer)
-		      (setq form (cdr form))
-		      (setq index (1+ index))))
-		   ((= index (nth 1 info))
-		    (if position
-			(princ (format (if quoted "'(#$ . %d)"  "(#$ . %d)")
-				       position)
-			       outbuffer)
-		      (let ((print-escape-newlines nil))
-			(goto-char (prog1 (1+ (point))
-				     (prin1 (car form) outbuffer)))
-			(insert "\\\n")
-			(goto-char (point-max)))))
-		   (t
-		    (prin1 (car form) outbuffer)))))
-	 (insert (nth 2 info))))))
-  nil)
-
-(defun byte-compile-keep-pending (form &optional handler)
-  (if (memq byte-optimize '(t source))
-      (setq form (byte-optimize-form form t)))
-  (if handler
-      (let ((for-effect t))
-	;; To avoid consing up monstrously large forms at load time, we split
-	;; the output regularly.
-	(and (memq (car-safe form) '(fset defalias))
-	     (nthcdr 300 byte-compile-output)
-	     (byte-compile-flush-pending))
-	(funcall handler form)
-	(if for-effect
-	    (byte-compile-discard)))
-    (byte-compile-form form t))
-  nil)
-
-(defun byte-compile-flush-pending ()
-  (if byte-compile-output
-      (let ((form (byte-compile-out-toplevel t 'file)))
-	(cond ((eq (car-safe form) 'progn)
-	       (mapcar 'byte-compile-output-file-form (cdr form)))
-	      (form
-	       (byte-compile-output-file-form form)))
-	(setq byte-compile-constants nil
-	      byte-compile-variables nil
-	      byte-compile-depth 0
-	      byte-compile-maxdepth 0
-	      byte-compile-output nil))))
-
-(defun byte-compile-file-form (form)
-  (let ((byte-compile-current-form nil)	; close over this for warnings.
-	handler)
-    (cond
-     ((not (consp form))
-      (byte-compile-keep-pending form))
-     ((and (symbolp (car form))
-	   (setq handler (get (car form) 'byte-hunk-handler)))
-      (cond ((setq form (funcall handler form))
-	     (byte-compile-flush-pending)
-	     (byte-compile-output-file-form form))))
-     ((eq form (setq form (macroexpand form byte-compile-macro-environment)))
-      (byte-compile-keep-pending form))
-     (t
-      (byte-compile-file-form form)))))
-
-;; Functions and variables with doc strings must be output separately,
-;; so make-docfile can recognise them.  Most other things can be output
-;; as byte-code.
-
-(put 'defsubst 'byte-hunk-handler 'byte-compile-file-form-defsubst)
-(defun byte-compile-file-form-defsubst (form)
-  (cond ((assq (nth 1 form) byte-compile-unresolved-functions)
-	 (setq byte-compile-current-form (nth 1 form))
-	 (byte-compile-warn "defsubst %s was used before it was defined"
-			    (nth 1 form))))
-  (byte-compile-file-form
-   (macroexpand form byte-compile-macro-environment))
-  ;; Return nil so the form is not output twice.
-  nil)
-
-(put 'autoload 'byte-hunk-handler 'byte-compile-file-form-autoload)
-(defun byte-compile-file-form-autoload (form)
-  (and (let ((form form))
-	 (while (if (setq form (cdr form)) (byte-compile-constp (car form))))
-	 (null form))			;Constants only
-       (eval (nth 5 form))		;Macro
-       (eval form))			;Define the autoload.
-  (if (stringp (nth 3 form))
-      form
-    ;; No doc string, so we can compile this as a normal form.
-    (byte-compile-keep-pending form 'byte-compile-normal-call)))
-
-(put 'defvar   'byte-hunk-handler 'byte-compile-file-form-defvar)
-(put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar)
-(defun byte-compile-file-form-defvar (form)
-  (if (null (nth 3 form))
-      ;; Since there is no doc string, we can compile this as a normal form,
-      ;; and not do a file-boundary.
-      (byte-compile-keep-pending form)
-    (if (memq 'free-vars byte-compile-warnings)
-	(setq byte-compile-bound-variables
-	      (cons (nth 1 form) byte-compile-bound-variables)))
-    (cond ((consp (nth 2 form))
-	   (setq form (copy-sequence form))
-	   (setcar (cdr (cdr form))
-		   (byte-compile-top-level (nth 2 form) nil 'file))))
-    form))
-
-(put 'require 'byte-hunk-handler 'byte-compile-file-form-eval-boundary)
-(defun byte-compile-file-form-eval-boundary (form)
-  (eval form)
-  (byte-compile-keep-pending form 'byte-compile-normal-call))
-
-(put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn)
-(put 'prog1 'byte-hunk-handler 'byte-compile-file-form-progn)
-(put 'prog2 'byte-hunk-handler 'byte-compile-file-form-progn)
-(defun byte-compile-file-form-progn (form)
-  (mapcar 'byte-compile-file-form (cdr form))
-  ;; Return nil so the forms are not output twice.
-  nil)
-
-;; This handler is not necessary, but it makes the output from dont-compile
-;; and similar macros cleaner.
-(put 'eval 'byte-hunk-handler 'byte-compile-file-form-eval)
-(defun byte-compile-file-form-eval (form)
-  (if (eq (car-safe (nth 1 form)) 'quote)
-      (nth 1 (nth 1 form))
-    (byte-compile-keep-pending form)))
-
-(put 'defun 'byte-hunk-handler 'byte-compile-file-form-defun)
-(defun byte-compile-file-form-defun (form)
-  (byte-compile-file-form-defmumble form nil))
-
-(put 'defmacro 'byte-hunk-handler 'byte-compile-file-form-defmacro)
-(defun byte-compile-file-form-defmacro (form)
-  (byte-compile-file-form-defmumble form t))
-
-(defun byte-compile-file-form-defmumble (form macrop)
-  (let* ((name (car (cdr form)))
-	 (this-kind (if macrop 'byte-compile-macro-environment
-		      'byte-compile-function-environment))
-	 (that-kind (if macrop 'byte-compile-function-environment
-		      'byte-compile-macro-environment))
-	 (this-one (assq name (symbol-value this-kind)))
-	 (that-one (assq name (symbol-value that-kind)))
-	 (byte-compile-free-references nil)
-	 (byte-compile-free-assignments nil))
-
-    ;; When a function or macro is defined, add it to the call tree so that
-    ;; we can tell when functions are not used.
-    (if byte-compile-generate-call-tree
-	(or (assq name byte-compile-call-tree)
-	    (setq byte-compile-call-tree
-		  (cons (list name nil nil) byte-compile-call-tree))))
-
-    (setq byte-compile-current-form name) ; for warnings
-    (if (memq 'redefine byte-compile-warnings)
-	(byte-compile-arglist-warn form macrop))
-    (if byte-compile-verbose
-	(message "Compiling %s... (%s)" (or filename "") (nth 1 form)))
-    (cond (that-one
-	   (if (and (memq 'redefine byte-compile-warnings)
-		    ;; don't warn when compiling the stubs in byte-run...
-		    (not (assq (nth 1 form)
-			       byte-compile-initial-macro-environment)))
-	       (byte-compile-warn
-		 "%s defined multiple times, as both function and macro"
-		 (nth 1 form)))
-	   (setcdr that-one nil))
-	  (this-one
-	   (if (and (memq 'redefine byte-compile-warnings)
-		    ;; hack: don't warn when compiling the magic internal
-		    ;; byte-compiler macros in byte-run.el...
-		    (not (assq (nth 1 form)
-			       byte-compile-initial-macro-environment)))
-	       (byte-compile-warn "%s %s defined multiple times in this file"
-				  (if macrop "macro" "function")
-				  (nth 1 form))))
-	  ((and (fboundp name)
-		(eq (car-safe (symbol-function name))
-		    (if macrop 'lambda 'macro)))
-	   (if (memq 'redefine byte-compile-warnings)
-	       (byte-compile-warn "%s %s being redefined as a %s"
-				  (if macrop "function" "macro")
-				  (nth 1 form)
-				  (if macrop "macro" "function")))
-	   ;; shadow existing definition
-	   (set this-kind
-		(cons (cons name nil) (symbol-value this-kind))))
-	  )
-    (let ((body (nthcdr 3 form)))
-      (if (and (stringp (car body))
-	       (symbolp (car-safe (cdr-safe body)))
-	       (car-safe (cdr-safe body))
-	       (stringp (car-safe (cdr-safe (cdr-safe body)))))
-	  (byte-compile-warn "Probable `\"' without `\\' in doc string of %s"
-			     (nth 1 form))))
-    (let* ((new-one (byte-compile-lambda (cons 'lambda (nthcdr 2 form))))
-	   (code (byte-compile-byte-code-maker new-one)))
-      (if this-one
-	  (setcdr this-one new-one)
-	(set this-kind
-	     (cons (cons name new-one) (symbol-value this-kind))))
-      (if (and (stringp (nth 3 form))
-	       (eq 'quote (car-safe code))
-	       (eq 'lambda (car-safe (nth 1 code))))
-	  (cons (car form)
-		(cons name (cdr (nth 1 code))))
-	(byte-compile-flush-pending)
-	(if (not (stringp (nth 3 form)))
-	    ;; No doc string.  Provide -1 as the "doc string index"
-	    ;; so that no element will be treated as a doc string.
-	    (byte-compile-output-docform
-	     (if (byte-compile-version-cond byte-compile-compatibility)
-		 "\n(fset '" "\n(defalias '")
-	     name
-	     (cond ((atom code)
-		    (if macrop '(" '(macro . #[" -1 "])") '(" #[" -1 "]")))
-		   ((eq (car code) 'quote)
-		    (setq code new-one)
-		    (if macrop '(" '(macro " -1 ")") '(" '(" -1 ")")))
-		   ((if macrop '(" (cons 'macro (" -1 "))") '(" (" -1 ")"))))
-	     (append code nil)
-	     (and (atom code) byte-compile-dynamic
-		  1)
-	     nil)
-	  ;; Output the form by hand, that's much simpler than having
-	  ;; b-c-output-file-form analyze the defalias.
-	  (byte-compile-output-docform
-	   (if (byte-compile-version-cond byte-compile-compatibility)
-	       "\n(fset '" "\n(defalias '")
-	   name
-	   (cond ((atom code)
-		  (if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]")))
-		 ((eq (car code) 'quote)
-		  (setq code new-one)
-		  (if macrop '(" '(macro " 2 ")") '(" '(" 2 ")")))
-		 ((if macrop '(" (cons 'macro (" 5 "))") '(" (" 5 ")"))))
-	   (append code nil)
-	   (and (atom code) byte-compile-dynamic
-		1)
-	   nil))
-	(princ ")" outbuffer)
-	nil))))
-
-;; Print Lisp object EXP in the output file, inside a comment,
-;; and return the file position it will have.
-;; If QUOTED is non-nil, print with quoting; otherwise, print without quoting.
-(defun byte-compile-output-as-comment (exp quoted)
-  (let ((position (point)))
-    (set-buffer
-     (prog1 (current-buffer)
-       (set-buffer outbuffer)
-
-       ;; Insert EXP, and make it a comment with #@LENGTH.
-       (insert " ")
-       (if quoted
-	   (prin1 exp outbuffer)
-	 (princ exp outbuffer))
-       (goto-char position)
-       ;; Quote certain special characters as needed.
-       ;; get_doc_string in doc.c does the unquoting.
-       (while (search-forward "\^A" nil t)
-	 (replace-match "\^A\^A" t t))
-       (goto-char position)
-       (while (search-forward "\000" nil t)
-	 (replace-match "\^A0" t t))
-       (goto-char position)
-       (while (search-forward "\037" nil t)
-	 (replace-match "\^A_" t t))
-       (goto-char (point-max))
-       (insert "\037")
-       (goto-char position)
-       (insert "#@" (format "%d" (- (point-max) position)))
-
-       ;; Save the file position of the object.
-       ;; Note we should add 1 to skip the space
-       ;; that we inserted before the actual doc string,
-       ;; and subtract 1 to convert from an 1-origin Emacs position
-       ;; to a file position; they cancel.
-       (setq position (point))
-       (goto-char (point-max))))
-    position))
-
-
-
-;;;###autoload
-(defun byte-compile (form)
-  "If FORM is a symbol, byte-compile its function definition.
-If FORM is a lambda or a macro, byte-compile it as a function."
-  (displaying-byte-compile-warnings
-   (byte-compile-close-variables
-    (let* ((fun (if (symbolp form)
-		    (and (fboundp form) (symbol-function form))
-		  form))
-	   (macro (eq (car-safe fun) 'macro)))
-      (if macro
-	  (setq fun (cdr fun)))
-      (cond ((eq (car-safe fun) 'lambda)
-	     (setq fun (if macro
-			   (cons 'macro (byte-compile-lambda fun))
-			 (byte-compile-lambda fun)))
-	     (if (symbolp form)
-		 (defalias form fun)
-	       fun)))))))
-
-(defun byte-compile-sexp (sexp)
-  "Compile and return SEXP."
-  (displaying-byte-compile-warnings
-   (byte-compile-close-variables
-    (byte-compile-top-level sexp))))
-
-;; Given a function made by byte-compile-lambda, make a form which produces it.
-(defun byte-compile-byte-code-maker (fun)
-  (cond
-   ((byte-compile-version-cond byte-compile-compatibility)
-    ;; Return (quote (lambda ...)).
-    (list 'quote (byte-compile-byte-code-unmake fun)))
-   ;; ## atom is faster than compiled-func-p.
-   ((atom fun)				; compiled function.
-    ;; generate-emacs19-bytecodes must be on, otherwise byte-compile-lambda
-    ;; would have produced a lambda.
-    fun)
-   ;; b-c-lambda didn't produce a compiled-function, so it's either a trivial
-   ;; function, or this is Emacs 18, or generate-emacs19-bytecodes is off.
-   ((let (tmp)
-      (if (and (setq tmp (assq 'byte-code (cdr-safe (cdr fun))))
-	       (null (cdr (memq tmp fun))))
-	  ;; Generate a make-byte-code call.
-	  (let* ((interactive (assq 'interactive (cdr (cdr fun)))))
-	    (nconc (list 'make-byte-code
-			 (list 'quote (nth 1 fun)) ;arglist
-			 (nth 1 tmp)	;bytes
-			 (nth 2 tmp)	;consts
-			 (nth 3 tmp))	;depth
-		   (cond ((stringp (nth 2 fun))
-			  (list (nth 2 fun))) ;doc
-			 (interactive
-			  (list nil)))
-		   (cond (interactive
-			  (list (if (or (null (nth 1 interactive))
-					(stringp (nth 1 interactive)))
-				    (nth 1 interactive)
-				  ;; Interactive spec is a list or a variable
-				  ;; (if it is correct).
-				  (list 'quote (nth 1 interactive))))))))
-	;; a non-compiled function (probably trivial)
-	(list 'quote fun))))))
-
-;; Turn a function into an ordinary lambda.  Needed for v18 files.
-(defun byte-compile-byte-code-unmake (function)
-  (if (consp function)
-      function;;It already is a lambda.
-    (setq function (append function nil)) ; turn it into a list
-    (nconc (list 'lambda (nth 0 function))
-	   (and (nth 4 function) (list (nth 4 function)))
-	   (if (nthcdr 5 function)
-	       (list (cons 'interactive (if (nth 5 function)
-					    (nthcdr 5 function)))))
-	   (list (list 'byte-code
-		       (nth 1 function) (nth 2 function)
-		       (nth 3 function))))))
-
-
-;; Byte-compile a lambda-expression and return a valid function.
-;; The value is usually a compiled function but may be the original
-;; lambda-expression.
-(defun byte-compile-lambda (fun)
-  (let* ((arglist (nth 1 fun))
-	 (byte-compile-bound-variables
-	  (nconc (and (memq 'free-vars byte-compile-warnings)
-		      (delq '&rest (delq '&optional (copy-sequence arglist))))
-		 byte-compile-bound-variables))
-	 (body (cdr (cdr fun)))
-	 (doc (if (stringp (car body))
-		  (prog1 (car body)
-		    ;; Discard the doc string
-		    ;; unless it is the last element of the body.
-		    (if (nthcdr 2 body)
-			(setq body (cdr body))))))
-	 (int (assq 'interactive body)))
-    (cond (int
-	   ;; Skip (interactive) if it is in front (the most usual location).
-	   (if (eq int (car body))
-	       (setq body (cdr body)))
-	   (cond ((consp (cdr int))
-		  (if (cdr (cdr int))
-		      (byte-compile-warn "malformed interactive spec: %s"
-					 (prin1-to-string int)))
-		  ;; If the interactive spec is a call to `list',
-		  ;; don't compile it, because `call-interactively'
-		  ;; looks at the args of `list'.
-		  (let ((form (nth 1 int)))
-		    (while (or (eq (car-safe form) 'let)
-			       (eq (car-safe form) 'let*)
-			       (eq (car-safe form) 'save-excursion))
-		      (while (consp (cdr form))
-			(setq form (cdr form)))
-		      (setq form (car form)))
-		    (or (eq (car-safe form) 'list)
-			(setq int (list 'interactive
-					(byte-compile-top-level (nth 1 int)))))))
-		 ((cdr int)
-		  (byte-compile-warn "malformed interactive spec: %s"
-				     (prin1-to-string int))))))
-    (let ((compiled (byte-compile-top-level (cons 'progn body) nil 'lambda)))
-      (if (and (eq 'byte-code (car-safe compiled))
-	       (not (byte-compile-version-cond
-		     byte-compile-compatibility)))
-	  (apply 'make-byte-code
-		 (append (list arglist)
-			 ;; byte-string, constants-vector, stack depth
-			 (cdr compiled)
-			 ;; optionally, the doc string.
-			 (if (or doc int)
-			     (list doc))
-			 ;; optionally, the interactive spec.
-			 (if int
-			     (list (nth 1 int)))))
-	(setq compiled
-	      (nconc (if int (list int))
-		     (cond ((eq (car-safe compiled) 'progn) (cdr compiled))
-			   (compiled (list compiled)))))
-	(nconc (list 'lambda arglist)
-	       (if (or doc (stringp (car compiled)))
-		   (cons doc (cond (compiled)
-				   (body (list nil))))
-		 compiled))))))
-
-(defun byte-compile-constants-vector ()
-  ;; Builds the constants-vector from the current variables and constants.
-  ;;   This modifies the constants from (const . nil) to (const . offset).
-  ;; To keep the byte-codes to look up the vector as short as possible:
-  ;;   First 6 elements are vars, as there are one-byte varref codes for those.
-  ;;   Next up to byte-constant-limit are constants, still with one-byte codes.
-  ;;   Next variables again, to get 2-byte codes for variable lookup.
-  ;;   The rest of the constants and variables need 3-byte byte-codes.
-  (let* ((i -1)
-	 (rest (nreverse byte-compile-variables)) ; nreverse because the first
-	 (other (nreverse byte-compile-constants)) ; vars often are used most.
-	 ret tmp
-	 (limits '(5			; Use the 1-byte varref codes,
-		   63  ; 1-constlim	;  1-byte byte-constant codes,
-		   255			;  2-byte varref codes,
-		   65535))		;  3-byte codes for the rest.
-	 limit)
-    (while (or rest other)
-      (setq limit (car limits))
-      (while (and rest (not (eq i limit)))
-	(if (setq tmp (assq (car (car rest)) ret))
-	    (setcdr (car rest) (cdr tmp))
-	  (setcdr (car rest) (setq i (1+ i)))
-	  (setq ret (cons (car rest) ret)))
-	(setq rest (cdr rest)))
-      (setq limits (cdr limits)
-	    rest (prog1 other
-		   (setq other rest))))
-    (apply 'vector (nreverse (mapcar 'car ret)))))
-
-;; Given an expression FORM, compile it and return an equivalent byte-code
-;; expression (a call to the function byte-code).
-(defun byte-compile-top-level (form &optional for-effect output-type)
-  ;; OUTPUT-TYPE advises about how form is expected to be used:
-  ;;	'eval or nil	-> a single form,
-  ;;	'progn or t	-> a list of forms,
-  ;;	'lambda		-> body of a lambda,
-  ;;	'file		-> used at file-level.
-  (let ((byte-compile-constants nil)
-	(byte-compile-variables nil)
-	(byte-compile-tag-number 0)
-	(byte-compile-depth 0)
-	(byte-compile-maxdepth 0)
-	(byte-compile-output nil))
-     (if (memq byte-optimize '(t source))
-	 (setq form (byte-optimize-form form for-effect)))
-     (while (and (eq (car-safe form) 'progn) (null (cdr (cdr form))))
-       (setq form (nth 1 form)))
-     (if (and (eq 'byte-code (car-safe form))
-	      (not (memq byte-optimize '(t byte)))
-	      (stringp (nth 1 form)) (vectorp (nth 2 form))
-	      (natnump (nth 3 form)))
-	 form
-       (byte-compile-form form for-effect)
-       (byte-compile-out-toplevel for-effect output-type))))
-
-(defun byte-compile-out-toplevel (&optional for-effect output-type)
-  (if for-effect
-      ;; The stack is empty. Push a value to be returned from (byte-code ..).
-      (if (eq (car (car byte-compile-output)) 'byte-discard)
-	  (setq byte-compile-output (cdr byte-compile-output))
-	(byte-compile-push-constant
-	 ;; Push any constant - preferably one which already is used, and
-	 ;; a number or symbol - ie not some big sequence.  The return value
-	 ;; isn't returned, but it would be a shame if some textually large
-	 ;; constant was not optimized away because we chose to return it.
-	 (and (not (assq nil byte-compile-constants)) ; Nil is often there.
-	      (let ((tmp (reverse byte-compile-constants)))
-		(while (and tmp (not (or (symbolp (car (car tmp)))
-					 (numberp (car (car tmp))))))
-		  (setq tmp (cdr tmp)))
-		(car (car tmp)))))))
-  (byte-compile-out 'byte-return 0)
-  (setq byte-compile-output (nreverse byte-compile-output))
-  (if (memq byte-optimize '(t byte))
-      (setq byte-compile-output
-	    (byte-optimize-lapcode byte-compile-output for-effect)))
-  
-  ;; Decompile trivial functions:
-  ;; only constants and variables, or a single funcall except in lambdas.
-  ;; Except for Lisp_Compiled objects, forms like (foo "hi")
-  ;; are still quicker than (byte-code "..." [foo "hi"] 2).
-  ;; Note that even (quote foo) must be parsed just as any subr by the
-  ;; interpreter, so quote should be compiled into byte-code in some contexts.
-  ;; What to leave uncompiled:
-  ;;	lambda	-> never.  we used to leave it uncompiled if the body was
-  ;;		   a single atom, but that causes confusion if the docstring
-  ;;		   uses the (file . pos) syntax.  Besides, now that we have
-  ;;		   the Lisp_Compiled type, the compiled form is faster.
-  ;;	eval	-> atom, quote or (function atom atom atom)
-  ;;	progn	-> as <<same-as-eval>> or (progn <<same-as-eval>> atom)
-  ;;	file	-> as progn, but takes both quotes and atoms, and longer forms.
-  (let (rest
-	(maycall (not (eq output-type 'lambda))) ; t if we may make a funcall.
-	tmp body)
-    (cond
-     ;; #### This should be split out into byte-compile-nontrivial-function-p.
-     ((or (eq output-type 'lambda)
-	  (nthcdr (if (eq output-type 'file) 50 8) byte-compile-output)
-	  (assq 'TAG byte-compile-output) ; Not necessary, but speeds up a bit.
-	  (not (setq tmp (assq 'byte-return byte-compile-output)))
-	  (progn
-	    (setq rest (nreverse
-			(cdr (memq tmp (reverse byte-compile-output)))))
-	    (while (cond
-		    ((memq (car (car rest)) '(byte-varref byte-constant))
-		     (setq tmp (car (cdr (car rest))))
-		     (if (if (eq (car (car rest)) 'byte-constant)
-			     (or (consp tmp)
-				 (and (symbolp tmp)
-				      (not (memq tmp '(nil t))))))
-			 (if maycall
-			     (setq body (cons (list 'quote tmp) body)))
-		       (setq body (cons tmp body))))
-		    ((and maycall
-			  ;; Allow a funcall if at most one atom follows it.
-			  (null (nthcdr 3 rest))
-			  (setq tmp (get (car (car rest)) 'byte-opcode-invert))
-			  (or (null (cdr rest))
-			      (and (memq output-type '(file progn t))
-				   (cdr (cdr rest))
-				   (eq (car (nth 1 rest)) 'byte-discard)
-				   (progn (setq rest (cdr rest)) t))))
-		     (setq maycall nil)	; Only allow one real function call.
-		     (setq body (nreverse body))
-		     (setq body (list
-				 (if (and (eq tmp 'funcall)
-					  (eq (car-safe (car body)) 'quote))
-				     (cons (nth 1 (car body)) (cdr body))
-				   (cons tmp body))))
-		     (or (eq output-type 'file)
-			 (not (delq nil (mapcar 'consp (cdr (car body))))))))
-	      (setq rest (cdr rest)))
-	    rest))
-      (let ((byte-compile-vector (byte-compile-constants-vector)))
-	(list 'byte-code (byte-compile-lapcode byte-compile-output)
-	      byte-compile-vector byte-compile-maxdepth)))
-     ;; it's a trivial function
-     ((cdr body) (cons 'progn (nreverse body)))
-     ((car body)))))
-
-;; Given BODY, compile it and return a new body.
-(defun byte-compile-top-level-body (body &optional for-effect)
-  (setq body (byte-compile-top-level (cons 'progn body) for-effect t))
-  (cond ((eq (car-safe body) 'progn)
-	 (cdr body))
-	(body
-	 (list body))))
-
-;; This is the recursive entry point for compiling each subform of an 
-;; expression.
-;; If for-effect is non-nil, byte-compile-form will output a byte-discard
-;; before terminating (ie no value will be left on the stack).
-;; A byte-compile handler may, when for-effect is non-nil, choose output code
-;; which does not leave a value on the stack, and then set for-effect to nil
-;; (to prevent byte-compile-form from outputting the byte-discard).
-;; If a handler wants to call another handler, it should do so via
-;; byte-compile-form, or take extreme care to handle for-effect correctly.
-;; (Use byte-compile-form-do-effect to reset the for-effect flag too.)
-;;
-(defun byte-compile-form (form &optional for-effect)
-  (setq form (macroexpand form byte-compile-macro-environment))
-  (cond ((not (consp form))
-	 (cond ((or (not (symbolp form)) (memq form '(nil t)))
-		(byte-compile-constant form))
-	       ((and for-effect byte-compile-delete-errors)
-		(setq for-effect nil))
-	       (t (byte-compile-variable-ref 'byte-varref form))))
-	((symbolp (car form))
-	 (let* ((fn (car form))
-		(handler (get fn 'byte-compile)))
-	   (if (memq fn '(t nil))
-	       (byte-compile-warn "%s called as a function" fn))
-	   (if (and handler
-		    (or (not (byte-compile-version-cond
-			      byte-compile-compatibility))
-			(not (get (get fn 'byte-opcode) 'emacs19-opcode))))
-	       (funcall handler form)
-	     (if (memq 'callargs byte-compile-warnings)
-		 (byte-compile-callargs-warn form))
-	     (byte-compile-normal-call form))))
-	((and (or (byte-code-function-p (car form))
-		  (eq (car-safe (car form)) 'lambda))
-	      ;; if the form comes out the same way it went in, that's
-	      ;; because it was malformed, and we couldn't unfold it.
-	      (not (eq form (setq form (byte-compile-unfold-lambda form)))))
-	 (byte-compile-form form for-effect)
-	 (setq for-effect nil))
-	((byte-compile-normal-call form)))
-  (if for-effect
-      (byte-compile-discard)))
-
-(defun byte-compile-normal-call (form)
-  (if byte-compile-generate-call-tree
-      (byte-compile-annotate-call-tree form))
-  (byte-compile-push-constant (car form))
-  (mapcar 'byte-compile-form (cdr form)) ; wasteful, but faster.
-  (byte-compile-out 'byte-call (length (cdr form))))
-
-(defun byte-compile-variable-ref (base-op var)
-  (if (or (not (symbolp var)) (memq var '(nil t)))
-      (byte-compile-warn (if (eq base-op 'byte-varbind)
-			     "Attempt to let-bind %s %s"
-			   "Variable reference to %s %s")
-			 (if (symbolp var) "constant" "nonvariable")
-			 (prin1-to-string var))
-    (if (and (get var 'byte-obsolete-variable)
-	     (memq 'obsolete byte-compile-warnings))
-	(let ((ob (get var 'byte-obsolete-variable)))
-	  (byte-compile-warn "%s is an obsolete variable; %s" var
-			     (if (stringp ob)
-				 ob
-			       (format "use %s instead." ob)))))
-    (if (memq 'free-vars byte-compile-warnings)
-	(if (eq base-op 'byte-varbind)
-	    (setq byte-compile-bound-variables
-		  (cons var byte-compile-bound-variables))
-	  (or (boundp var)
-	      (memq var byte-compile-bound-variables)
-	      (if (eq base-op 'byte-varset)
-		  (or (memq var byte-compile-free-assignments)
-		      (progn
-			(byte-compile-warn "assignment to free variable %s" var)
-			(setq byte-compile-free-assignments
-			      (cons var byte-compile-free-assignments))))
-		(or (memq var byte-compile-free-references)
-		    (progn
-		      (byte-compile-warn "reference to free variable %s" var)
-		      (setq byte-compile-free-references
-			    (cons var byte-compile-free-references)))))))))
-  (let ((tmp (assq var byte-compile-variables)))
-    (or tmp
-	(setq tmp (list var)
-	      byte-compile-variables (cons tmp byte-compile-variables)))
-    (byte-compile-out base-op tmp)))
-
-(defmacro byte-compile-get-constant (const)
-  (` (or (if (stringp (, const))
-	     (assoc (, const) byte-compile-constants)
-	   (assq (, const) byte-compile-constants))
-	 (car (setq byte-compile-constants
-		    (cons (list (, const)) byte-compile-constants))))))
-
-;; Use this when the value of a form is a constant.  This obeys for-effect.
-(defun byte-compile-constant (const)
-  (if for-effect
-      (setq for-effect nil)
-    (byte-compile-out 'byte-constant (byte-compile-get-constant const))))
-
-;; Use this for a constant that is not the value of its containing form.
-;; This ignores for-effect.
-(defun byte-compile-push-constant (const)
-  (let ((for-effect nil))
-    (inline (byte-compile-constant const))))
-
-
-;; Compile those primitive ordinary functions
-;; which have special byte codes just for speed.
-
-(defmacro byte-defop-compiler (function &optional compile-handler)
-  ;; add a compiler-form for FUNCTION.
-  ;; If function is a symbol, then the variable "byte-SYMBOL" must name
-  ;; the opcode to be used.  If function is a list, the first element
-  ;; is the function and the second element is the bytecode-symbol.
-  ;; COMPILE-HANDLER is the function to use to compile this byte-op, or
-  ;; may be the abbreviations 0, 1, 2, 3, 0-1, or 1-2.
-  ;; If it is nil, then the handler is "byte-compile-SYMBOL."
-  (let (opcode)
-    (if (symbolp function)
-	(setq opcode (intern (concat "byte-" (symbol-name function))))
-      (setq opcode (car (cdr function))
-	    function (car function)))
-    (let ((fnform
-	   (list 'put (list 'quote function) ''byte-compile
-		 (list 'quote
-		       (or (cdr (assq compile-handler
-				      '((0 . byte-compile-no-args)
-					(1 . byte-compile-one-arg)
-					(2 . byte-compile-two-args)
-					(3 . byte-compile-three-args)
-					(0-1 . byte-compile-zero-or-one-arg)
-					(1-2 . byte-compile-one-or-two-args)
-					(2-3 . byte-compile-two-or-three-args)
-					)))
-			   compile-handler
-			   (intern (concat "byte-compile-"
-					   (symbol-name function))))))))
-      (if opcode
-	  (list 'progn fnform
-		(list 'put (list 'quote function)
-		      ''byte-opcode (list 'quote opcode))
-		(list 'put (list 'quote opcode)
-		      ''byte-opcode-invert (list 'quote function)))
-	fnform))))
-
-(defmacro byte-defop-compiler19 (function &optional compile-handler)
-  ;; Just like byte-defop-compiler, but defines an opcode that will only
-  ;; be used when byte-compile-compatibility is false.
-  (if (and (byte-compile-single-version)
-	   byte-compile-compatibility)
-      ;; #### instead of doing nothing, this should do some remprops,
-      ;; #### to protect against the case where a single-version compiler
-      ;; #### is loaded into a world that has contained a multi-version one.
-      nil
-    (list 'progn
-      (list 'put
-	(list 'quote
-	  (or (car (cdr-safe function))
-	      (intern (concat "byte-"
-		        (symbol-name (or (car-safe function) function))))))
-	''emacs19-opcode t)
-      (list 'byte-defop-compiler function compile-handler))))
-
-(defmacro byte-defop-compiler-1 (function &optional compile-handler)
-  (list 'byte-defop-compiler (list function nil) compile-handler))
-
-
-(put 'byte-call 'byte-opcode-invert 'funcall)
-(put 'byte-list1 'byte-opcode-invert 'list)
-(put 'byte-list2 'byte-opcode-invert 'list)
-(put 'byte-list3 'byte-opcode-invert 'list)
-(put 'byte-list4 'byte-opcode-invert 'list)
-(put 'byte-listN 'byte-opcode-invert 'list)
-(put 'byte-concat2 'byte-opcode-invert 'concat)
-(put 'byte-concat3 'byte-opcode-invert 'concat)
-(put 'byte-concat4 'byte-opcode-invert 'concat)
-(put 'byte-concatN 'byte-opcode-invert 'concat)
-(put 'byte-insertN 'byte-opcode-invert 'insert)
-
-(byte-defop-compiler (dot byte-point)		0)
-(byte-defop-compiler (dot-max byte-point-max)	0)
-(byte-defop-compiler (dot-min byte-point-min)	0)
-(byte-defop-compiler point		0)
-;;(byte-defop-compiler mark		0) ;; obsolete
-(byte-defop-compiler point-max		0)
-(byte-defop-compiler point-min		0)
-(byte-defop-compiler following-char	0)
-(byte-defop-compiler preceding-char	0)
-(byte-defop-compiler current-column	0)
-(byte-defop-compiler eolp		0)
-(byte-defop-compiler eobp		0)
-(byte-defop-compiler bolp		0)
-(byte-defop-compiler bobp		0)
-(byte-defop-compiler current-buffer	0)
-;;(byte-defop-compiler read-char	0) ;; obsolete
-(byte-defop-compiler interactive-p	0)
-(byte-defop-compiler19 widen		0)
-(byte-defop-compiler19 end-of-line    0-1)
-(byte-defop-compiler19 forward-char   0-1)
-(byte-defop-compiler19 forward-line   0-1)
-(byte-defop-compiler symbolp		1)
-(byte-defop-compiler consp		1)
-(byte-defop-compiler stringp		1)
-(byte-defop-compiler listp		1)
-(byte-defop-compiler not		1)
-(byte-defop-compiler (null byte-not)	1)
-(byte-defop-compiler car		1)
-(byte-defop-compiler cdr		1)
-(byte-defop-compiler length		1)
-(byte-defop-compiler symbol-value	1)
-(byte-defop-compiler symbol-function	1)
-(byte-defop-compiler (1+ byte-add1)	1)
-(byte-defop-compiler (1- byte-sub1)	1)
-(byte-defop-compiler goto-char		1)
-(byte-defop-compiler char-after		1)
-(byte-defop-compiler set-buffer		1)
-;;(byte-defop-compiler set-mark		1) ;; obsolete
-(byte-defop-compiler19 forward-word	1)
-(byte-defop-compiler19 char-syntax	1)
-(byte-defop-compiler19 nreverse		1)
-(byte-defop-compiler19 car-safe		1)
-(byte-defop-compiler19 cdr-safe		1)
-(byte-defop-compiler19 numberp		1)
-(byte-defop-compiler19 integerp		1)
-(byte-defop-compiler19 skip-chars-forward     1-2)
-(byte-defop-compiler19 skip-chars-backward    1-2)
-(byte-defop-compiler (eql byte-eq) 	2)
-(byte-defop-compiler eq 	 	2)
-(byte-defop-compiler memq		2)
-(byte-defop-compiler cons		2)
-(byte-defop-compiler aref		2)
-(byte-defop-compiler set		2)
-(byte-defop-compiler (= byte-eqlsign)	2)
-(byte-defop-compiler (< byte-lss)	2)
-(byte-defop-compiler (> byte-gtr)	2)
-(byte-defop-compiler (<= byte-leq)	2)
-(byte-defop-compiler (>= byte-geq)	2)
-(byte-defop-compiler get		2)
-(byte-defop-compiler nth		2)
-(byte-defop-compiler substring		2-3)
-(byte-defop-compiler19 (move-marker byte-set-marker) 2-3)
-(byte-defop-compiler19 set-marker	2-3)
-(byte-defop-compiler19 match-beginning	1)
-(byte-defop-compiler19 match-end	1)
-(byte-defop-compiler19 upcase		1)
-(byte-defop-compiler19 downcase		1)
-(byte-defop-compiler19 string=		2)
-(byte-defop-compiler19 string<		2)
-(byte-defop-compiler19 (string-equal byte-string=) 2)
-(byte-defop-compiler19 (string-lessp byte-string<) 2)
-(byte-defop-compiler19 equal		2)
-(byte-defop-compiler19 nthcdr		2)
-(byte-defop-compiler19 elt		2)
-(byte-defop-compiler19 member		2)
-(byte-defop-compiler19 assq		2)
-(byte-defop-compiler19 (rplaca byte-setcar) 2)
-(byte-defop-compiler19 (rplacd byte-setcdr) 2)
-(byte-defop-compiler19 setcar		2)
-(byte-defop-compiler19 setcdr		2)
-(byte-defop-compiler19 buffer-substring	2)
-(byte-defop-compiler19 delete-region	2)
-(byte-defop-compiler19 narrow-to-region	2)
-(byte-defop-compiler19 (% byte-rem)	2)
-(byte-defop-compiler aset		3)
-
-(byte-defop-compiler max		byte-compile-associative)
-(byte-defop-compiler min		byte-compile-associative)
-(byte-defop-compiler (+ byte-plus)	byte-compile-associative)
-(byte-defop-compiler19 (* byte-mult)	byte-compile-associative)
-
-;;####(byte-defop-compiler19 move-to-column	1)
-(byte-defop-compiler-1 interactive byte-compile-noop)
-
-
-(defun byte-compile-subr-wrong-args (form n)
-  (byte-compile-warn "%s called with %d arg%s, but requires %s"
-		     (car form) (length (cdr form))
-		     (if (= 1 (length (cdr form))) "" "s") n)
-  ;; get run-time wrong-number-of-args error.
-  (byte-compile-normal-call form))
-
-(defun byte-compile-no-args (form)
-  (if (not (= (length form) 1))
-      (byte-compile-subr-wrong-args form "none")
-    (byte-compile-out (get (car form) 'byte-opcode) 0)))
-
-(defun byte-compile-one-arg (form)
-  (if (not (= (length form) 2))
-      (byte-compile-subr-wrong-args form 1)
-    (byte-compile-form (car (cdr form)))  ;; Push the argument
-    (byte-compile-out (get (car form) 'byte-opcode) 0)))
-
-(defun byte-compile-two-args (form)
-  (if (not (= (length form) 3))
-      (byte-compile-subr-wrong-args form 2)
-    (byte-compile-form (car (cdr form)))  ;; Push the arguments
-    (byte-compile-form (nth 2 form))
-    (byte-compile-out (get (car form) 'byte-opcode) 0)))
-
-(defun byte-compile-three-args (form)
-  (if (not (= (length form) 4))
-      (byte-compile-subr-wrong-args form 3)
-    (byte-compile-form (car (cdr form)))  ;; Push the arguments
-    (byte-compile-form (nth 2 form))
-    (byte-compile-form (nth 3 form))
-    (byte-compile-out (get (car form) 'byte-opcode) 0)))
-
-(defun byte-compile-zero-or-one-arg (form)
-  (let ((len (length form)))
-    (cond ((= len 1) (byte-compile-one-arg (append form '(nil))))
-	  ((= len 2) (byte-compile-one-arg form))
-	  (t (byte-compile-subr-wrong-args form "0-1")))))
-
-(defun byte-compile-one-or-two-args (form)
-  (let ((len (length form)))
-    (cond ((= len 2) (byte-compile-two-args (append form '(nil))))
-	  ((= len 3) (byte-compile-two-args form))
-	  (t (byte-compile-subr-wrong-args form "1-2")))))
-
-(defun byte-compile-two-or-three-args (form)
-  (let ((len (length form)))
-    (cond ((= len 3) (byte-compile-three-args (append form '(nil))))
-	  ((= len 4) (byte-compile-three-args form))
-	  (t (byte-compile-subr-wrong-args form "2-3")))))
-
-(defun byte-compile-noop (form)
-  (byte-compile-constant nil))
-
-(defun byte-compile-discard ()
-  (byte-compile-out 'byte-discard 0))
-
-
-;; Compile a function that accepts one or more args and is right-associative.
-;; We do it by left-associativity so that the operations
-;; are done in the same order as in interpreted code.
-;; We treat the one-arg case, as in (+ x), like (+ x 0).
-;; in order to convert markers to numbers, and trigger expected errors.
-(defun byte-compile-associative (form)
-  (if (cdr form)
-      (let ((opcode (get (car form) 'byte-opcode))
-	    (args (copy-sequence (cdr form))))
-	(byte-compile-form (car args))
-	(setq args (cdr args))
-	(or args (setq args '(0)
-		       opcode (get '+ 'byte-opcode)))
-	(while args
-	  (byte-compile-form (car args))
-	  (byte-compile-out opcode 0)
-	  (setq args (cdr args))))
-    (byte-compile-constant (eval form))))
-
-
-;; more complicated compiler macros
-
-(byte-defop-compiler list)
-(byte-defop-compiler concat)
-(byte-defop-compiler fset)
-(byte-defop-compiler (indent-to-column byte-indent-to) byte-compile-indent-to)
-(byte-defop-compiler indent-to)
-(byte-defop-compiler insert)
-(byte-defop-compiler-1 function byte-compile-function-form)
-(byte-defop-compiler-1 - byte-compile-minus)
-(byte-defop-compiler19 (/ byte-quo) byte-compile-quo)
-(byte-defop-compiler19 nconc)
-(byte-defop-compiler-1 beginning-of-line)
-
-(defun byte-compile-list (form)
-  (let ((count (length (cdr form))))
-    (cond ((= count 0)
-	   (byte-compile-constant nil))
-	  ((< count 5)
-	   (mapcar 'byte-compile-form (cdr form))
-	   (byte-compile-out
-	    (aref [byte-list1 byte-list2 byte-list3 byte-list4] (1- count)) 0))
-	  ((and (< count 256) (not (byte-compile-version-cond
-				    byte-compile-compatibility)))
-	   (mapcar 'byte-compile-form (cdr form))
-	   (byte-compile-out 'byte-listN count))
-	  (t (byte-compile-normal-call form)))))
-
-(defun byte-compile-concat (form)
-  (let ((count (length (cdr form))))
-    (cond ((and (< 1 count) (< count 5))
-	   (mapcar 'byte-compile-form (cdr form))
-	   (byte-compile-out
-	    (aref [byte-concat2 byte-concat3 byte-concat4] (- count 2))
-	    0))
-	  ;; Concat of one arg is not a no-op if arg is not a string.
-	  ((= count 0)
-	   (byte-compile-form ""))
-	  ((and (< count 256) (not (byte-compile-version-cond
-				    byte-compile-compatibility)))
-	   (mapcar 'byte-compile-form (cdr form))
-	   (byte-compile-out 'byte-concatN count))
-	  ((byte-compile-normal-call form)))))
-
-(defun byte-compile-minus (form)
-  (if (null (setq form (cdr form)))
-      (byte-compile-constant 0)
-    (byte-compile-form (car form))
-    (if (cdr form)
-	(while (setq form (cdr form))
-	  (byte-compile-form (car form))
-	  (byte-compile-out 'byte-diff 0))
-      (byte-compile-out 'byte-negate 0))))
-
-(defun byte-compile-quo (form)
-  (let ((len (length form)))
-    (cond ((<= len 2)
-	   (byte-compile-subr-wrong-args form "2 or more"))
-	  (t
-	   (byte-compile-form (car (setq form (cdr form))))
-	   (while (setq form (cdr form))
-	     (byte-compile-form (car form))
-	     (byte-compile-out 'byte-quo 0))))))
-
-(defun byte-compile-nconc (form)
-  (let ((len (length form)))
-    (cond ((= len 1)
-	   (byte-compile-constant nil))
-	  ((= len 2)
-	   ;; nconc of one arg is a noop, even if that arg isn't a list.
-	   (byte-compile-form (nth 1 form)))
-	  (t
-	   (byte-compile-form (car (setq form (cdr form))))
-	   (while (setq form (cdr form))
-	     (byte-compile-form (car form))
-	     (byte-compile-out 'byte-nconc 0))))))
-
-(defun byte-compile-fset (form)
-  ;; warn about forms like (fset 'foo '(lambda () ...))
-  ;; (where the lambda expression is non-trivial...)
-  (let ((fn (nth 2 form))
-	body)
-    (if (and (eq (car-safe fn) 'quote)
-	     (eq (car-safe (setq fn (nth 1 fn))) 'lambda))
-	(progn
-	  (setq body (cdr (cdr fn)))
-	  (if (stringp (car body)) (setq body (cdr body)))
-	  (if (eq 'interactive (car-safe (car body))) (setq body (cdr body)))
-	  (if (and (consp (car body))
-		   (not (eq 'byte-code (car (car body)))))
-	      (byte-compile-warn
-      "A quoted lambda form is the second argument of fset.  This is probably
-     not what you want, as that lambda cannot be compiled.  Consider using
-     the syntax (function (lambda (...) ...)) instead.")))))
-  (byte-compile-two-args form))
-
-(defun byte-compile-funarg (form)
-  ;; (mapcar '(lambda (x) ..) ..) ==> (mapcar (function (lambda (x) ..)) ..)
-  ;; for cases where it's guaranteed that first arg will be used as a lambda.
-  (byte-compile-normal-call
-   (let ((fn (nth 1 form)))
-     (if (and (eq (car-safe fn) 'quote)
-	      (eq (car-safe (nth 1 fn)) 'lambda))
-	 (cons (car form)
-	       (cons (cons 'function (cdr fn))
-		     (cdr (cdr form))))
-       form))))
-
-(defun byte-compile-funarg-2 (form)
-  ;; (sort ... '(lambda (x) ..)) ==> (sort ... (function (lambda (x) ..)))
-  ;; for cases where it's guaranteed that second arg will be used as a lambda.
-  (byte-compile-normal-call
-   (let ((fn (nth 2 form)))
-     (if (and (eq (car-safe fn) 'quote)
-	      (eq (car-safe (nth 1 fn)) 'lambda))
-	 (cons (car form)
-	       (cons (nth 1 form)
-		     (cons (cons 'function (cdr fn))
-			   (cdr (cdr (cdr form))))))
-       form))))
-
-;; (function foo) must compile like 'foo, not like (symbol-function 'foo).
-;; Otherwise it will be incompatible with the interpreter,
-;; and (funcall (function foo)) will lose with autoloads.
-
-(defun byte-compile-function-form (form)
-  (byte-compile-constant
-   (cond ((symbolp (nth 1 form))
-	  (nth 1 form))
-	 ;; If we're not allowed to use #[] syntax, then output a form like
-	 ;; '(lambda (..) (byte-code ..)) instead of a call to make-byte-code.
-	 ;; In this situation, calling make-byte-code at run-time will usually
-	 ;; be less efficient than processing a call to byte-code.
-	 ((byte-compile-version-cond byte-compile-compatibility)
-	  (byte-compile-byte-code-unmake (byte-compile-lambda (nth 1 form))))
-	 ((byte-compile-lambda (nth 1 form))))))
-
-(defun byte-compile-indent-to (form)
-  (let ((len (length form)))
-    (cond ((= len 2)
-	   (byte-compile-form (car (cdr form)))
-	   (byte-compile-out 'byte-indent-to 0))
-	  ((= len 3)
-	   ;; no opcode for 2-arg case.
-	   (byte-compile-normal-call form))
-	  (t
-	   (byte-compile-subr-wrong-args form "1-2")))))
-
-(defun byte-compile-insert (form)
-  (cond ((null (cdr form))
-	 (byte-compile-constant nil))
-	((and (not (byte-compile-version-cond
-		    byte-compile-compatibility))
-	      (<= (length form) 256))
-	 (mapcar 'byte-compile-form (cdr form))
-	 (if (cdr (cdr form))
-	     (byte-compile-out 'byte-insertN (length (cdr form)))
-	   (byte-compile-out 'byte-insert 0)))
-	((memq t (mapcar 'consp (cdr (cdr form))))
-	 (byte-compile-normal-call form))
-	;; We can split it; there is no function call after inserting 1st arg.
-	(t
-	 (while (setq form (cdr form))
-	   (byte-compile-form (car form))
-	   (byte-compile-out 'byte-insert 0)
-	   (if (cdr form)
-	       (byte-compile-discard))))))
-
-(defun byte-compile-beginning-of-line (form)
-  (if (not (byte-compile-constp (nth 1 form)))
-      (byte-compile-normal-call form)
-    (byte-compile-form
-     (list 'forward-line
-	   (if (integerp (setq form (or (eval (nth 1 form)) 1)))
-	       (1- form)
-	     (byte-compile-warn "Non-numeric arg to beginning-of-line: %s"
-				form)
-	     (list '1- (list 'quote form))))
-     t)
-    (byte-compile-constant nil)))
-
-
-(byte-defop-compiler-1 setq)
-(byte-defop-compiler-1 setq-default)
-(byte-defop-compiler-1 quote)
-(byte-defop-compiler-1 quote-form)
-
-(defun byte-compile-setq (form)
-  (let ((args (cdr form)))
-    (if args
-	(while args
-	  (byte-compile-form (car (cdr args)))
-	  (or for-effect (cdr (cdr args))
-	      (byte-compile-out 'byte-dup 0))
-	  (byte-compile-variable-ref 'byte-varset (car args))
-	  (setq args (cdr (cdr args))))
-      ;; (setq), with no arguments.
-      (byte-compile-form nil for-effect))
-    (setq for-effect nil)))
-
-(defun byte-compile-setq-default (form)
-  (let ((args (cdr form))
-	setters)
-    (while args
-      (setq setters
-	    (cons (list 'set-default (list 'quote (car args)) (car (cdr args)))
-		  setters))
-      (setq args (cdr (cdr args))))
-    (byte-compile-form (cons 'progn (nreverse setters)))))
-
-(defun byte-compile-quote (form)
-  (byte-compile-constant (car (cdr form))))
-
-(defun byte-compile-quote-form (form)
-  (byte-compile-constant (byte-compile-top-level (nth 1 form))))
-
-
-;;; control structures
-
-(defun byte-compile-body (body &optional for-effect)
-  (while (cdr body)
-    (byte-compile-form (car body) t)
-    (setq body (cdr body)))
-  (byte-compile-form (car body) for-effect))
-
-(defsubst byte-compile-body-do-effect (body)
-  (byte-compile-body body for-effect)
-  (setq for-effect nil))
-
-(defsubst byte-compile-form-do-effect (form)
-  (byte-compile-form form for-effect)
-  (setq for-effect nil))
-
-(byte-defop-compiler-1 inline byte-compile-progn)
-(byte-defop-compiler-1 progn)
-(byte-defop-compiler-1 prog1)
-(byte-defop-compiler-1 prog2)
-(byte-defop-compiler-1 if)
-(byte-defop-compiler-1 cond)
-(byte-defop-compiler-1 and)
-(byte-defop-compiler-1 or)
-(byte-defop-compiler-1 while)
-(byte-defop-compiler-1 funcall)
-(byte-defop-compiler-1 apply byte-compile-funarg)
-(byte-defop-compiler-1 mapcar byte-compile-funarg)
-(byte-defop-compiler-1 mapatoms byte-compile-funarg)
-(byte-defop-compiler-1 mapconcat byte-compile-funarg)
-(byte-defop-compiler-1 sort byte-compile-funarg-2)
-(byte-defop-compiler-1 let)
-(byte-defop-compiler-1 let*)
-
-(defun byte-compile-progn (form)
-  (byte-compile-body-do-effect (cdr form)))
-
-(defun byte-compile-prog1 (form)
-  (byte-compile-form-do-effect (car (cdr form)))
-  (byte-compile-body (cdr (cdr form)) t))
-
-(defun byte-compile-prog2 (form)
-  (byte-compile-form (nth 1 form) t)
-  (byte-compile-form-do-effect (nth 2 form))
-  (byte-compile-body (cdr (cdr (cdr form))) t))
-
-(defmacro byte-compile-goto-if (cond discard tag)
-  (` (byte-compile-goto
-      (if (, cond)
-	  (if (, discard) 'byte-goto-if-not-nil 'byte-goto-if-not-nil-else-pop)
-	(if (, discard) 'byte-goto-if-nil 'byte-goto-if-nil-else-pop))
-      (, tag))))
-
-(defun byte-compile-if (form)
-  (byte-compile-form (car (cdr form)))
-  (if (null (nthcdr 3 form))
-      ;; No else-forms
-      (let ((donetag (byte-compile-make-tag)))
-	(byte-compile-goto-if nil for-effect donetag)
-	(byte-compile-form (nth 2 form) for-effect)
-	(byte-compile-out-tag donetag))
-    (let ((donetag (byte-compile-make-tag)) (elsetag (byte-compile-make-tag)))
-      (byte-compile-goto 'byte-goto-if-nil elsetag)
-      (byte-compile-form (nth 2 form) for-effect)
-      (byte-compile-goto 'byte-goto donetag)
-      (byte-compile-out-tag elsetag)
-      (byte-compile-body (cdr (cdr (cdr form))) for-effect)
-      (byte-compile-out-tag donetag)))
-  (setq for-effect nil))
-
-(defun byte-compile-cond (clauses)
-  (let ((donetag (byte-compile-make-tag))
-	nexttag clause)
-    (while (setq clauses (cdr clauses))
-      (setq clause (car clauses))
-      (cond ((or (eq (car clause) t)
-		 (and (eq (car-safe (car clause)) 'quote)
-		      (car-safe (cdr-safe (car clause)))))
-	     ;; Unconditional clause
-	     (setq clause (cons t clause)
-		   clauses nil))
-	    ((cdr clauses)
-	     (byte-compile-form (car clause))
-	     (if (null (cdr clause))
-		 ;; First clause is a singleton.
-		 (byte-compile-goto-if t for-effect donetag)
-	       (setq nexttag (byte-compile-make-tag))
-	       (byte-compile-goto 'byte-goto-if-nil nexttag)
-	       (byte-compile-body (cdr clause) for-effect)
-	       (byte-compile-goto 'byte-goto donetag)
-	       (byte-compile-out-tag nexttag)))))
-    ;; Last clause
-    (and (cdr clause) (not (eq (car clause) t))
-	 (progn (byte-compile-form (car clause))
-		(byte-compile-goto-if nil for-effect donetag)
-		(setq clause (cdr clause))))
-    (byte-compile-body-do-effect clause)
-    (byte-compile-out-tag donetag)))
-
-(defun byte-compile-and (form)
-  (let ((failtag (byte-compile-make-tag))
-	(args (cdr form)))
-    (if (null args)
-	(byte-compile-form-do-effect t)
-      (while (cdr args)
-	(byte-compile-form (car args))
-	(byte-compile-goto-if nil for-effect failtag)
-	(setq args (cdr args)))
-      (byte-compile-form-do-effect (car args))
-      (byte-compile-out-tag failtag))))
-
-(defun byte-compile-or (form)
-  (let ((wintag (byte-compile-make-tag))
-	(args (cdr form)))
-    (if (null args)
-	(byte-compile-form-do-effect nil)
-      (while (cdr args)
-	(byte-compile-form (car args))
-	(byte-compile-goto-if t for-effect wintag)
-	(setq args (cdr args)))
-      (byte-compile-form-do-effect (car args))
-      (byte-compile-out-tag wintag))))
-
-(defun byte-compile-while (form)
-  (let ((endtag (byte-compile-make-tag))
-	(looptag (byte-compile-make-tag)))
-    (byte-compile-out-tag looptag)
-    (byte-compile-form (car (cdr form)))
-    (byte-compile-goto-if nil for-effect endtag)
-    (byte-compile-body (cdr (cdr form)) t)
-    (byte-compile-goto 'byte-goto looptag)
-    (byte-compile-out-tag endtag)
-    (setq for-effect nil)))
-
-(defun byte-compile-funcall (form)
-  (mapcar 'byte-compile-form (cdr form))
-  (byte-compile-out 'byte-call (length (cdr (cdr form)))))
-
-
-(defun byte-compile-let (form)
-  ;; First compute the binding values in the old scope.
-  (let ((varlist (car (cdr form))))
-    (while varlist
-      (if (consp (car varlist))
-	  (byte-compile-form (car (cdr (car varlist))))
-	(byte-compile-push-constant nil))
-      (setq varlist (cdr varlist))))
-  (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope
-	(varlist (reverse (car (cdr form)))))
-    (while varlist
-      (byte-compile-variable-ref 'byte-varbind (if (consp (car varlist))
-						   (car (car varlist))
-						 (car varlist)))
-      (setq varlist (cdr varlist)))
-    (byte-compile-body-do-effect (cdr (cdr form)))
-    (byte-compile-out 'byte-unbind (length (car (cdr form))))))
-
-(defun byte-compile-let* (form)
-  (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope
-	(varlist (copy-sequence (car (cdr form)))))
-    (while varlist
-      (if (atom (car varlist))
-	  (byte-compile-push-constant nil)
-	(byte-compile-form (car (cdr (car varlist))))
-	(setcar varlist (car (car varlist))))
-      (byte-compile-variable-ref 'byte-varbind (car varlist))
-      (setq varlist (cdr varlist)))
-    (byte-compile-body-do-effect (cdr (cdr form)))
-    (byte-compile-out 'byte-unbind (length (car (cdr form))))))
-
-
-(byte-defop-compiler-1 /= byte-compile-negated)
-(byte-defop-compiler-1 atom byte-compile-negated)
-(byte-defop-compiler-1 nlistp byte-compile-negated)
-
-(put '/= 'byte-compile-negated-op '=)
-(put 'atom 'byte-compile-negated-op 'consp)
-(put 'nlistp 'byte-compile-negated-op 'listp)
-
-(defun byte-compile-negated (form)
-  (byte-compile-form-do-effect (byte-compile-negation-optimizer form)))
-
-;; Even when optimization is off, /= is optimized to (not (= ...)).
-(defun byte-compile-negation-optimizer (form)
-  ;; an optimizer for forms where <form1> is less efficient than (not <form2>)
-  (list 'not
-    (cons (or (get (car form) 'byte-compile-negated-op)
-	      (error
-	       "Compiler error: `%s' has no `byte-compile-negated-op' property"
-	       (car form)))
-	  (cdr form))))
-
-;;; other tricky macro-like special-forms
-
-(byte-defop-compiler-1 catch)
-(byte-defop-compiler-1 unwind-protect)
-(byte-defop-compiler-1 condition-case)
-(byte-defop-compiler-1 save-excursion)
-(byte-defop-compiler-1 save-current-buffer)
-(byte-defop-compiler-1 save-restriction)
-(byte-defop-compiler-1 save-window-excursion)
-(byte-defop-compiler-1 with-output-to-temp-buffer)
-(byte-defop-compiler-1 track-mouse)
-
-(defun byte-compile-catch (form)
-  (byte-compile-form (car (cdr form)))
-  (byte-compile-push-constant
-    (byte-compile-top-level (cons 'progn (cdr (cdr form))) for-effect))
-  (byte-compile-out 'byte-catch 0))
-
-(defun byte-compile-unwind-protect (form)
-  (byte-compile-push-constant
-   (byte-compile-top-level-body (cdr (cdr form)) t))
-  (byte-compile-out 'byte-unwind-protect 0)
-  (byte-compile-form-do-effect (car (cdr form)))
-  (byte-compile-out 'byte-unbind 1))
-
-(defun byte-compile-track-mouse (form)
-  (byte-compile-form
-   (list
-    'funcall
-    (list 'quote
-	  (list 'lambda nil
-		(cons 'track-mouse
-		      (byte-compile-top-level-body (cdr form))))))))
-
-(defun byte-compile-condition-case (form)
-  (let* ((var (nth 1 form))
-	 (byte-compile-bound-variables
-	  (if var (cons var byte-compile-bound-variables)
-	    byte-compile-bound-variables)))
-    (or (symbolp var)
-	(byte-compile-warn
-	 "%s is not a variable-name or nil (in condition-case)" var))
-    (byte-compile-push-constant var)
-    (byte-compile-push-constant (byte-compile-top-level
-				 (nth 2 form) for-effect))
-    (let ((clauses (cdr (cdr (cdr form))))
-	  compiled-clauses)
-      (while clauses
-	(let* ((clause (car clauses))
-               (condition (car clause)))
-          (cond ((not (or (symbolp condition)
-			  (and (listp condition)
-			       (let ((syms condition) (ok t))
-				 (while syms
-				   (if (not (symbolp (car syms)))
-				       (setq ok nil))
-				   (setq syms (cdr syms)))
-				 ok))))
-                 (byte-compile-warn
-                   "%s is not a condition name or list of such (in condition-case)"
-                   (prin1-to-string condition)))
-;;                ((not (or (eq condition 't)
-;;			  (and (stringp (get condition 'error-message))
-;;			       (consp (get condition 'error-conditions)))))
-;;                 (byte-compile-warn
-;;                   "%s is not a known condition name (in condition-case)" 
-;;                   condition))
-		)
-	  (setq compiled-clauses
-		(cons (cons condition
-			    (byte-compile-top-level-body
-			     (cdr clause) for-effect))
-		      compiled-clauses)))
-	(setq clauses (cdr clauses)))
-      (byte-compile-push-constant (nreverse compiled-clauses)))
-    (byte-compile-out 'byte-condition-case 0)))
-
-
-(defun byte-compile-save-excursion (form)
-  (byte-compile-out 'byte-save-excursion 0)
-  (byte-compile-body-do-effect (cdr form))
-  (byte-compile-out 'byte-unbind 1))
-
-(defun byte-compile-save-restriction (form)
-  (byte-compile-out 'byte-save-restriction 0)
-  (byte-compile-body-do-effect (cdr form))
-  (byte-compile-out 'byte-unbind 1))
-
-(defun byte-compile-save-current-buffer (form)
-  (byte-compile-out 'byte-save-current-buffer 0)
-  (byte-compile-body-do-effect (cdr form))
-  (byte-compile-out 'byte-unbind 1))
-
-(defun byte-compile-save-window-excursion (form)
-  (byte-compile-push-constant
-   (byte-compile-top-level-body (cdr form) for-effect))
-  (byte-compile-out 'byte-save-window-excursion 0))
-
-(defun byte-compile-with-output-to-temp-buffer (form)
-  (byte-compile-form (car (cdr form)))
-  (byte-compile-out 'byte-temp-output-buffer-setup 0)
-  (byte-compile-body (cdr (cdr form)))
-  (byte-compile-out 'byte-temp-output-buffer-show 0))
-
-
-;;; top-level forms elsewhere
-
-(byte-defop-compiler-1 defun)
-(byte-defop-compiler-1 defmacro)
-(byte-defop-compiler-1 defvar)
-(byte-defop-compiler-1 defconst byte-compile-defvar)
-(byte-defop-compiler-1 autoload)
-(byte-defop-compiler-1 lambda byte-compile-lambda-form)
-(byte-defop-compiler-1 defalias)
-
-(defun byte-compile-defun (form)
-  ;; This is not used for file-level defuns with doc strings.
-  (byte-compile-two-args ; Use this to avoid byte-compile-fset's warning.
-   (list 'fset (list 'quote (nth 1 form))
-	 (byte-compile-byte-code-maker
-	  (byte-compile-lambda (cons 'lambda (cdr (cdr form)))))))
-  (byte-compile-discard)
-  (byte-compile-constant (nth 1 form)))
-
-(defun byte-compile-defmacro (form)
-  ;; This is not used for file-level defmacros with doc strings.
-  (byte-compile-body-do-effect
-   (list (list 'fset (list 'quote (nth 1 form))
-	       (let ((code (byte-compile-byte-code-maker
-			    (byte-compile-lambda
-			     (cons 'lambda (cdr (cdr form)))))))
-		 (if (eq (car-safe code) 'make-byte-code)
-		     (list 'cons ''macro code)
-		   (list 'quote (cons 'macro (eval code))))))
-	 (list 'quote (nth 1 form)))))
-
-(defun byte-compile-defvar (form)
-  ;; This is not used for file-level defvar/consts with doc strings.
-  (let ((var (nth 1 form))
-	(value (nth 2 form))
-	(string (nth 3 form)))
-    (if (memq 'free-vars byte-compile-warnings)
-	(setq byte-compile-bound-variables
-	      (cons var byte-compile-bound-variables)))
-    (byte-compile-body-do-effect
-     (list (if (cdr (cdr form))
-	       (if (eq (car form) 'defconst)
-		   (list 'setq var value)
-		 (list 'or (list 'boundp (list 'quote var))
-		       (list 'setq var value))))
-	   ;; Put the defined variable in this library's load-history entry
-	   ;; just as a real defvar would.
-	   (list 'setq 'current-load-list
-		 (list 'cons (list 'quote var)
-		       'current-load-list))
-	   (if string 
-	       (list 'put (list 'quote var) ''variable-documentation string))
-	   (list 'quote var)))))
-
-(defun byte-compile-autoload (form)
-  (and (byte-compile-constp (nth 1 form))
-       (byte-compile-constp (nth 5 form))
-       (eval (nth 5 form))  ; macro-p
-       (not (fboundp (eval (nth 1 form))))
-       (byte-compile-warn
-	"The compiler ignores `autoload' except at top level.  You should 
-     probably put the autoload of the macro `%s' at top-level."
-	(eval (nth 1 form))))
-  (byte-compile-normal-call form))
-
-;; Lambda's in valid places are handled as special cases by various code.
-;; The ones that remain are errors.
-(defun byte-compile-lambda-form (form)
-  (error "`lambda' used as function name is invalid"))
-
-;; Compile normally, but deal with warnings for the function being defined.
-(defun byte-compile-defalias (form)
-  (if (and (consp (cdr form)) (consp (nth 1 form))
-	   (eq (car (nth 1 form)) 'quote)
-	   (consp (cdr (nth 1 form)))
-	   (symbolp (nth 1 (nth 1 form)))
-	   (consp (nthcdr 2 form))
-	   (consp (nth 2 form))
-	   (eq (car (nth 2 form)) 'quote)
-	   (consp (cdr (nth 2 form)))
-	   (symbolp (nth 1 (nth 2 form))))
-      (progn
-	(byte-compile-defalias-warn (nth 1 (nth 1 form))
-				    (nth 1 (nth 2 form)))
-	(setq byte-compile-function-environment
-	      (cons (cons (nth 1 (nth 1 form))
-			  (nth 1 (nth 2 form)))
-		    byte-compile-function-environment))))
-  (byte-compile-normal-call form))
-
-;; Turn off warnings about prior calls to the function being defalias'd.
-;; This could be smarter and compare those calls with
-;; the function it is being aliased to.
-(defun byte-compile-defalias-warn (new alias)
-  (let ((calls (assq new byte-compile-unresolved-functions)))
-    (if calls
-	(setq byte-compile-unresolved-functions
-	      (delq calls byte-compile-unresolved-functions)))))
-
-;;; tags
-
-;; Note: Most operations will strip off the 'TAG, but it speeds up
-;; optimization to have the 'TAG as a part of the tag.
-;; Tags will be (TAG . (tag-number . stack-depth)).
-(defun byte-compile-make-tag ()
-  (list 'TAG (setq byte-compile-tag-number (1+ byte-compile-tag-number))))
-
-
-(defun byte-compile-out-tag (tag)
-  (setq byte-compile-output (cons tag byte-compile-output))
-  (if (cdr (cdr tag))
-      (progn
-	;; ## remove this someday
-	(and byte-compile-depth
-	  (not (= (cdr (cdr tag)) byte-compile-depth))
-	  (error "Compiler bug: depth conflict at tag %d" (car (cdr tag))))
-	(setq byte-compile-depth (cdr (cdr tag))))
-    (setcdr (cdr tag) byte-compile-depth)))
-
-(defun byte-compile-goto (opcode tag)
-  (setq byte-compile-output (cons (cons opcode tag) byte-compile-output))
-  (setcdr (cdr tag) (if (memq opcode byte-goto-always-pop-ops)
-			(1- byte-compile-depth)
-		      byte-compile-depth))
-  (setq byte-compile-depth (and (not (eq opcode 'byte-goto))
-				(1- byte-compile-depth))))
-
-(defun byte-compile-out (opcode offset)
-  (setq byte-compile-output (cons (cons opcode offset) byte-compile-output))
-  (cond ((eq opcode 'byte-call)
-	 (setq byte-compile-depth (- byte-compile-depth offset)))
-	((eq opcode 'byte-return)
-	 ;; This is actually an unnecessary case, because there should be
-	 ;; no more opcodes behind byte-return.
-	 (setq byte-compile-depth nil))
-	(t
-	 (setq byte-compile-depth (+ byte-compile-depth
-				     (or (aref byte-stack+-info
-					       (symbol-value opcode))
-					 (- (1- offset))))
-	       byte-compile-maxdepth (max byte-compile-depth
-					  byte-compile-maxdepth))))
-  ;;(if (< byte-compile-depth 0) (error "Compiler error: stack underflow"))
-  )
-
-
-;;; call tree stuff
-
-(defun byte-compile-annotate-call-tree (form)
-  (let (entry)
-    ;; annotate the current call
-    (if (setq entry (assq (car form) byte-compile-call-tree))
-	(or (memq byte-compile-current-form (nth 1 entry)) ;callers
-	    (setcar (cdr entry)
-		    (cons byte-compile-current-form (nth 1 entry))))
-      (setq byte-compile-call-tree
-	    (cons (list (car form) (list byte-compile-current-form) nil)
-		  byte-compile-call-tree)))
-    ;; annotate the current function
-    (if (setq entry (assq byte-compile-current-form byte-compile-call-tree))
-	(or (memq (car form) (nth 2 entry)) ;called
-	    (setcar (cdr (cdr entry))
-		    (cons (car form) (nth 2 entry))))
-      (setq byte-compile-call-tree
-	    (cons (list byte-compile-current-form nil (list (car form)))
-		  byte-compile-call-tree)))
-    ))
-
-;; Renamed from byte-compile-report-call-tree
-;; to avoid interfering with completion of byte-compile-file.
-;;;###autoload
-(defun display-call-tree (&optional filename)
-  "Display a call graph of a specified file.
-This lists which functions have been called, what functions called
-them, and what functions they call.  The list includes all functions
-whose definitions have been compiled in this Emacs session, as well as
-all functions called by those functions.
-
-The call graph does not include macros, inline functions, or
-primitives that the byte-code interpreter knows about directly \(eq,
-cons, etc.\).
-
-The call tree also lists those functions which are not known to be called
-\(that is, to which no calls have been compiled\), and which cannot be
-invoked interactively."
-  (interactive)
-  (message "Generating call tree...")
-  (with-output-to-temp-buffer "*Call-Tree*"
-    (set-buffer "*Call-Tree*")
-    (erase-buffer)
-    (message "Generating call tree... (sorting on %s)"
-	     byte-compile-call-tree-sort)
-    (insert "Call tree for "
-	    (cond ((null byte-compile-current-file) (or filename "???"))
-		  ((stringp byte-compile-current-file)
-		   byte-compile-current-file)
-		  (t (buffer-name byte-compile-current-file)))
-	    " sorted on "
-	    (prin1-to-string byte-compile-call-tree-sort)
-	    ":\n\n")
-    (if byte-compile-call-tree-sort
-	(setq byte-compile-call-tree
-	      (sort byte-compile-call-tree
-		    (cond ((eq byte-compile-call-tree-sort 'callers)
-			   (function (lambda (x y) (< (length (nth 1 x))
-						      (length (nth 1 y))))))
-			  ((eq byte-compile-call-tree-sort 'calls)
-			   (function (lambda (x y) (< (length (nth 2 x))
-						      (length (nth 2 y))))))
-			  ((eq byte-compile-call-tree-sort 'calls+callers)
-			   (function (lambda (x y) (< (+ (length (nth 1 x))
-							 (length (nth 2 x)))
-						      (+ (length (nth 1 y))
-							 (length (nth 2 y)))))))
-			  ((eq byte-compile-call-tree-sort 'name)
-			   (function (lambda (x y) (string< (car x)
-							    (car y)))))
-			  (t (error "`byte-compile-call-tree-sort': `%s' - unknown sort mode"
-				    byte-compile-call-tree-sort))))))
-    (message "Generating call tree...")
-    (let ((rest byte-compile-call-tree)
-	  (b (current-buffer))
-	  f p
-	  callers calls)
-      (while rest
-	(prin1 (car (car rest)) b)
-	(setq callers (nth 1 (car rest))
-	      calls (nth 2 (car rest)))
-	(insert "\t"
-	  (cond ((not (fboundp (setq f (car (car rest)))))
-		 (if (null f)
-		     " <top level>";; shouldn't insert nil then, actually -sk
-		   " <not defined>"))
-		((subrp (setq f (symbol-function f)))
-		 " <subr>")
-		((symbolp f)
-		 (format " ==> %s" f))
-		((byte-code-function-p f)
-		 "<compiled function>")
-		((not (consp f))
-		 "<malformed function>")
-		((eq 'macro (car f))
-		 (if (or (byte-code-function-p (cdr f))
-			 (assq 'byte-code (cdr (cdr (cdr f)))))
-		     " <compiled macro>"
-		   " <macro>"))
-		((assq 'byte-code (cdr (cdr f)))
-		 "<compiled lambda>")
-		((eq 'lambda (car f))
-		 "<function>")
-		(t "???"))
-	  (format " (%d callers + %d calls = %d)"
-		  ;; Does the optimizer eliminate common subexpressions?-sk
-		  (length callers)
-		  (length calls)
-		  (+ (length callers) (length calls)))
-	  "\n")
-	(if callers
-	    (progn
-	      (insert "  called by:\n")
-	      (setq p (point))
-	      (insert "    " (if (car callers)
-				 (mapconcat 'symbol-name callers ", ")
-			       "<top level>"))
-	      (let ((fill-prefix "    "))
-		(fill-region-as-paragraph p (point)))))
-	(if calls
-	    (progn
-	      (insert "  calls:\n")
-	      (setq p (point))
-	      (insert "    " (mapconcat 'symbol-name calls ", "))
-	      (let ((fill-prefix "    "))
-		(fill-region-as-paragraph p (point)))))
-	(insert "\n")
-	(setq rest (cdr rest)))
-
-      (message "Generating call tree...(finding uncalled functions...)")
-      (setq rest byte-compile-call-tree)
-      (let ((uncalled nil))
-	(while rest
-	  (or (nth 1 (car rest))
-	      (null (setq f (car (car rest))))
-	      (byte-compile-fdefinition f t)
-	      (commandp (byte-compile-fdefinition f nil))
-	      (setq uncalled (cons f uncalled)))
-	  (setq rest (cdr rest)))
-	(if uncalled
-	    (let ((fill-prefix "  "))
-	      (insert "Noninteractive functions not known to be called:\n  ")
-	      (setq p (point))
-	      (insert (mapconcat 'symbol-name (nreverse uncalled) ", "))
-	      (fill-region-as-paragraph p (point)))))
-      )
-    (message "Generating call tree...done.")
-    ))
-
-
-;;; by crl@newton.purdue.edu
-;;;  Only works noninteractively.
-;;;###autoload
-(defun batch-byte-compile ()
-  "Run `byte-compile-file' on the files remaining on the command line.
-Use this from the command line, with `-batch';
-it won't work in an interactive Emacs.
-Each file is processed even if an error occurred previously.
-For example, invoke \"emacs -batch -f batch-byte-compile $emacs/ ~/*.el\""
-  ;; command-line-args-left is what is left of the command line (from startup.el)
-  (defvar command-line-args-left)	;Avoid 'free variable' warning
-  (if (not noninteractive)
-      (error "`batch-byte-compile' is to be used only with -batch"))
-  (let ((error nil))
-    (while command-line-args-left
-      (if (file-directory-p (expand-file-name (car command-line-args-left)))
-	  (let ((files (directory-files (car command-line-args-left)))
-		source dest)
-	    (while files
-	      (if (and (string-match emacs-lisp-file-regexp (car files))
-		       (not (auto-save-file-name-p (car files)))
-		       (setq source (expand-file-name (car files)
-						      (car command-line-args-left)))
-		       (setq dest (byte-compile-dest-file source))
-		       (file-exists-p dest)
-		       (file-newer-than-file-p source dest))
-		  (if (null (batch-byte-compile-file source))
-		      (setq error t)))
-	      (setq files (cdr files))))
-	(if (null (batch-byte-compile-file (car command-line-args-left)))
-	    (setq error t)))
-      (setq command-line-args-left (cdr command-line-args-left)))
-    (message "Done")
-    (kill-emacs (if error 1 0))))
-
-(defun batch-byte-compile-file (file)
-  (condition-case err
-      (progn (byte-compile-file file) t)
-    (error
-     (message (if (cdr err)
-		  ">>Error occurred processing %s: %s (%s)"
-		  ">>Error occurred processing %s: %s")
-	      file
-	      (get (car err) 'error-message)
-	      (prin1-to-string (cdr err)))
-     nil)))
-
-;;;###autoload
-(defun batch-byte-recompile-directory ()
-  "Runs `byte-recompile-directory' on the dirs remaining on the command line.
-Must be used only with `-batch', and kills Emacs on completion.
-For example, invoke `emacs -batch -f batch-byte-recompile-directory .'."
-  ;; command-line-args-left is what is left of the command line (startup.el)
-  (defvar command-line-args-left)	;Avoid 'free variable' warning
-  (if (not noninteractive)
-      (error "batch-byte-recompile-directory is to be used only with -batch"))
-  (or command-line-args-left
-      (setq command-line-args-left '(".")))
-  (while command-line-args-left
-    (byte-recompile-directory (car command-line-args-left))
-    (setq command-line-args-left (cdr command-line-args-left)))
-  (kill-emacs 0))
-
-
-(make-obsolete 'dot 'point)
-(make-obsolete 'dot-max 'point-max)
-(make-obsolete 'dot-min 'point-min)
-(make-obsolete 'dot-marker 'point-marker)
-
-(make-obsolete 'buffer-flush-undo 'buffer-disable-undo)
-(make-obsolete 'baud-rate "use the baud-rate variable instead")
-(make-obsolete 'compiled-function-p 'byte-code-function-p)
-(make-obsolete 'define-function 'defalias)
-(make-obsolete-variable 'auto-fill-hook 'auto-fill-function)
-(make-obsolete-variable 'blink-paren-hook 'blink-paren-function)
-(make-obsolete-variable 'lisp-indent-hook 'lisp-indent-function)
-(make-obsolete-variable 'temp-buffer-show-hook
-			'temp-buffer-show-function)
-(make-obsolete-variable 'inhibit-local-variables
-		"use enable-local-variables (with the reversed sense).")
-(make-obsolete-variable 'unread-command-char
-  "use unread-command-events instead.  That variable is a list of events to reread, so it now uses nil to mean `no event', instead of -1.")
-(make-obsolete-variable 'unread-command-event
-  "use unread-command-events; which is a list of events rather than a single event.")
-(make-obsolete-variable 'suspend-hooks 'suspend-hook)
-(make-obsolete-variable 'comment-indent-hook 'comment-indent-function)
-(make-obsolete-variable 'meta-flag "Use the set-input-mode function instead.")
-(make-obsolete-variable 'executing-macro 'executing-kbd-macro)
-(make-obsolete-variable 'before-change-function
-  "use before-change-functions; which is a list of functions rather than a single function.")
-(make-obsolete-variable 'after-change-function
-  "use after-change-functions; which is a list of functions rather than a single function.")
-(make-obsolete-variable 'font-lock-doc-string-face 'font-lock-string-face)
-(make-obsolete-variable 'post-command-idle-hook
-  "use timers instead, with `run-with-idle-timer'.")
-(make-obsolete-variable 'post-command-idle-delay
-  "use timers instead, with `run-with-idle-timer'.")
-
-(provide 'byte-compile)
-(provide 'bytecomp)
-
-
-;;; report metering (see the hacks in bytecode.c)
-
-(defun byte-compile-report-ops ()
-  (defvar byte-code-meter)
-  (with-output-to-temp-buffer "*Meter*"
-    (set-buffer "*Meter*")
-    (let ((i 0) n op off)
-      (while (< i 256)
-	(setq n (aref (aref byte-code-meter 0) i)
-	      off nil)
-	(if t				;(not (zerop n))
-	    (progn
-	      (setq op i)
-	      (setq off nil)
-	      (cond ((< op byte-nth)
-		     (setq off (logand op 7))
-		     (setq op (logand op 248)))
-		    ((>= op byte-constant)
-		     (setq off (- op byte-constant)
-			   op byte-constant)))
-	      (setq op (aref byte-code-vector op))
-	      (insert (format "%-4d" i))
-	      (insert (symbol-name op))
-	      (if off (insert " [" (int-to-string off) "]"))
-	      (indent-to 40)
-	      (insert (int-to-string n) "\n")))
-	(setq i (1+ i))))))
-
-;; To avoid "lisp nesting exceeds max-lisp-eval-depth" when bytecomp compiles
-;; itself, compile some of its most used recursive functions (at load time).
-;;
-(eval-when-compile
-  (or (byte-code-function-p (symbol-function 'byte-compile-form))
-      (assq 'byte-code (symbol-function 'byte-compile-form))
-      (let ((byte-optimize nil)		; do it fast
-	    (byte-compile-warnings nil))
-	(mapcar '(lambda (x)
-		   (or noninteractive (message "compiling %s..." x))
-		   (byte-compile x)
-		   (or noninteractive (message "compiling %s...done" x)))
-		'(byte-compile-normal-call
-		  byte-compile-form
-		  byte-compile-body
-		  ;; Inserted some more than necessary, to speed it up.
-		  byte-compile-top-level
-		  byte-compile-out-toplevel
-		  byte-compile-constant
-		  byte-compile-variable-ref))))
-  nil)
-
-;;; bytecomp.el ends here
diff --git a/lisp/emacs-lisp/cl-compat.el b/lisp/emacs-lisp/cl-compat.el
deleted file mode 100644
index 7d5b6492edf..00000000000
--- a/lisp/emacs-lisp/cl-compat.el
+++ /dev/null
@@ -1,192 +0,0 @@
-;;; cl-compat.el --- Common Lisp extensions for GNU Emacs Lisp (compatibility)
-
-;; Copyright (C) 1993 Free Software Foundation, Inc.
-
-;; Author: Dave Gillespie <daveg@synaptics.com>
-;; Version: 2.02
-;; Keywords: extensions
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; These are extensions to Emacs Lisp that provide a degree of
-;; Common Lisp compatibility, beyond what is already built-in
-;; in Emacs Lisp.
-;;
-;; This package was written by Dave Gillespie; it is a complete
-;; rewrite of Cesar Quiroz's original cl.el package of December 1986.
-;;
-;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19.
-;;
-;; Bug reports, comments, and suggestions are welcome!
-
-;; This file contains emulations of internal routines of the older
-;; CL package which users may have called directly from their code.
-;; Use (require 'cl-compat) to get these routines.
-
-;; See cl.el for Change Log.
-
-
-;;; Code:
-
-;; Require at load-time, but not when compiling cl-compat.
-(or (featurep 'cl) (require 'cl))
-
-
-;;; Keyword routines not supported by new package.
-
-(defmacro defkeyword (x &optional doc)
-  (list* 'defconst x (list 'quote x) (and doc (list doc))))
-
-(defun keywordp (sym)
-  (and (symbolp sym) (eq (aref (symbol-name sym) 0) ?\:) (set sym sym)))
-
-(defun keyword-of (sym)
-  (or (keywordp sym) (keywordp (intern (format ":%s" sym)))))
-
-
-;;; Multiple values.  Note that the new package uses a different
-;;; convention for multiple values.  The following definitions
-;;; emulate the old convention; all function names have been changed
-;;; by capitalizing the first letter: Values, Multiple-value-*,
-;;; to avoid conflict with the new-style definitions in cl-macs.
-
-(put 'Multiple-value-bind  'lisp-indent-function 2)
-(put 'Multiple-value-setq  'lisp-indent-function 2)
-(put 'Multiple-value-call  'lisp-indent-function 1)
-(put 'Multiple-value-prog1 'lisp-indent-function 1)
-
-(defvar *mvalues-values* nil)
-
-(defun Values (&rest val-forms)
-  (setq *mvalues-values* val-forms)
-  (car val-forms))
-
-(defun Values-list (val-forms)
-  (apply 'values val-forms))
-
-(defmacro Multiple-value-list (form)
-  (list 'let* (list '(*mvalues-values* nil) (list '*mvalues-temp* form))
-	'(or (and (eq *mvalues-temp* (car *mvalues-values*)) *mvalues-values*)
-	     (list *mvalues-temp*))))
-
-(defmacro Multiple-value-call (function &rest args)
-  (list 'apply function
-	(cons 'append
-	      (mapcar (function (lambda (x) (list 'Multiple-value-list x)))
-		      args))))
-
-(defmacro Multiple-value-bind (vars form &rest body)
-  (list* 'multiple-value-bind vars (list 'Multiple-value-list form) body))
-
-(defmacro Multiple-value-setq (vars form)
-  (list 'multiple-value-setq vars (list 'Multiple-value-list form)))
-
-(defmacro Multiple-value-prog1 (form &rest body)
-  (list 'prog1 form (list* 'let '((*mvalues-values* nil)) body)))
-
-
-;;; Routines for parsing keyword arguments.
-
-(defun build-klist (arglist keys &optional allow-others)
-  (let ((res (Multiple-value-call 'mapcar* 'cons (unzip-lists arglist))))
-    (or allow-others
-	(let ((bad (set-difference (mapcar 'car res) keys)))
-	  (if bad (error "Bad keywords: %s not in %s" bad keys))))
-    res))
-
-(defun extract-from-klist (klist key &optional def)
-  (let ((res (assq key klist))) (if res (cdr res) def)))
-
-(defun keyword-argument-supplied-p (klist key)
-  (assq key klist))
-
-(defun elt-satisfies-test-p (item elt klist)
-  (let ((test-not (cdr (assq ':test-not klist)))
-	(test (cdr (assq ':test klist)))
-	(key (cdr (assq ':key klist))))
-    (if key (setq elt (funcall key elt)))
-    (if test-not (not (funcall test-not item elt))
-      (funcall (or test 'eql) item elt))))
-
-
-;;; Rounding functions with old-style multiple value returns.
-
-(defun cl-floor (a &optional b) (Values-list (floor* a b)))
-(defun cl-ceiling (a &optional b) (Values-list (ceiling* a b)))
-(defun cl-round (a &optional b) (Values-list (round* a b)))
-(defun cl-truncate (a &optional b) (Values-list (truncate* a b)))
-
-(defun safe-idiv (a b)
-  (let* ((q (/ (abs a) (abs b)))
-         (s (* (signum a) (signum b))))
-    (Values q (- a (* s q b)) s)))
-
-
-;; Internal routines.
-
-(defun pair-with-newsyms (oldforms)
-  (let ((newsyms (mapcar (function (lambda (x) (gensym))) oldforms)))
-    (Values (mapcar* 'list newsyms oldforms) newsyms)))
-
-(defun zip-lists (evens odds)
-  (mapcan 'list evens odds))
-
-(defun unzip-lists (list)
-  (let ((e nil) (o nil))
-    (while list
-      (setq e (cons (car list) e) o (cons (cadr list) o) list (cddr list)))
-    (Values (nreverse e) (nreverse o))))
-
-(defun reassemble-argslists (list)
-  (let ((n (apply 'min (mapcar 'length list))) (res nil))
-    (while (>= (setq n (1- n)) 0)
-      (setq res (cons (mapcar (function (lambda (x) (elt x n))) list) res)))
-    res))
-
-(defun duplicate-symbols-p (list)
-  (let ((res nil))
-    (while list
-      (if (memq (car list) (cdr list)) (setq res (cons (car list) res)))
-      (setq list (cdr list)))
-    res))
-
-
-;;; Setf internals.
-
-(defun setnth (n list x)
-  (setcar (nthcdr n list) x))
-
-(defun setnthcdr (n list x)
-  (setcdr (nthcdr (1- n) list) x))
-
-(defun setelt (seq n x)
-  (if (consp seq) (setcar (nthcdr n seq) x) (aset seq n x)))
-
-
-;;; Functions omitted: case-clausify, check-do-stepforms, check-do-endforms,
-;;; extract-do-inits, extract-do[*]-steps, select-stepping-forms,
-;;; elt-satisfies-if[-not]-p, with-keyword-args, mv-bind-clausify,
-;;; all names with embedded `$'.
-
-
-(provide 'cl-compat)
-
-;;; cl-compat.el ends here
-
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
deleted file mode 100644
index 2402d799108..00000000000
--- a/lisp/emacs-lisp/cl-extra.el
+++ /dev/null
@@ -1,924 +0,0 @@
-;;; cl-extra.el --- Common Lisp features, part 2 -*-byte-compile-dynamic: t;-*-
-
-;; Copyright (C) 1993 Free Software Foundation, Inc.
-
-;; Author: Dave Gillespie <daveg@synaptics.com>
-;; Version: 2.02
-;; Keywords: extensions
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; These are extensions to Emacs Lisp that provide a degree of
-;; Common Lisp compatibility, beyond what is already built-in
-;; in Emacs Lisp.
-;;
-;; This package was written by Dave Gillespie; it is a complete
-;; rewrite of Cesar Quiroz's original cl.el package of December 1986.
-;;
-;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19.
-;;
-;; Bug reports, comments, and suggestions are welcome!
-
-;; This file contains portions of the Common Lisp extensions
-;; package which are autoloaded since they are relatively obscure.
-
-;; See cl.el for Change Log.
-
-
-;;; Code:
-
-(or (memq 'cl-19 features)
-    (error "Tried to load `cl-extra' before `cl'!"))
-
-
-;;; We define these here so that this file can compile without having
-;;; loaded the cl.el file already.
-
-(defmacro cl-push (x place) (list 'setq place (list 'cons x place)))
-(defmacro cl-pop (place)
-  (list 'car (list 'prog1 place (list 'setq place (list 'cdr place)))))
-
-(defvar cl-emacs-type)
-
-
-;;; Type coercion.
-
-(defun coerce (x type)
-  "Coerce OBJECT to type TYPE.
-TYPE is a Common Lisp type specifier."
-  (cond ((eq type 'list) (if (listp x) x (append x nil)))
-	((eq type 'vector) (if (vectorp x) x (vconcat x)))
-	((eq type 'string) (if (stringp x) x (concat x)))
-	((eq type 'array) (if (arrayp x) x (vconcat x)))
-	((and (eq type 'character) (stringp x) (= (length x) 1)) (aref x 0))
-	((and (eq type 'character) (symbolp x)) (coerce (symbol-name x) type))
-	((eq type 'float) (float x))
-	((typep x type) x)
-	(t (error "Can't coerce %s to type %s" x type))))
-
-
-;;; Predicates.
-
-(defun equalp (x y)
-  "T if two Lisp objects have similar structures and contents.
-This is like `equal', except that it accepts numerically equal
-numbers of different types (float vs. integer), and also compares
-strings case-insensitively."
-  (cond ((eq x y) t)
-	((stringp x)
-	 (and (stringp y) (= (length x) (length y))
-	      (or (string-equal x y)
-		  (string-equal (downcase x) (downcase y)))))   ; lazy but simple!
-	((numberp x)
-	 (and (numberp y) (= x y)))
-	((consp x)
-	 (while (and (consp x) (consp y) (equalp (car x) (car y)))
-	   (setq x (cdr x) y (cdr y)))
-	 (and (not (consp x)) (equalp x y)))
-	((vectorp x)
-	 (and (vectorp y) (= (length x) (length y))
-	      (let ((i (length x)))
-		(while (and (>= (setq i (1- i)) 0)
-			    (equalp (aref x i) (aref y i))))
-		(< i 0))))
-	(t (equal x y))))
-
-
-;;; Control structures.
-
-(defun cl-mapcar-many (cl-func cl-seqs)
-  (if (cdr (cdr cl-seqs))
-      (let* ((cl-res nil)
-	     (cl-n (apply 'min (mapcar 'length cl-seqs)))
-	     (cl-i 0)
-	     (cl-args (copy-sequence cl-seqs))
-	     cl-p1 cl-p2)
-	(setq cl-seqs (copy-sequence cl-seqs))
-	(while (< cl-i cl-n)
-	  (setq cl-p1 cl-seqs cl-p2 cl-args)
-	  (while cl-p1
-	    (setcar cl-p2
-		    (if (consp (car cl-p1))
-			(prog1 (car (car cl-p1))
-			  (setcar cl-p1 (cdr (car cl-p1))))
-		      (aref (car cl-p1) cl-i)))
-	    (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)))
-	  (cl-push (apply cl-func cl-args) cl-res)
-	  (setq cl-i (1+ cl-i)))
-	(nreverse cl-res))
-    (let ((cl-res nil)
-	  (cl-x (car cl-seqs))
-	  (cl-y (nth 1 cl-seqs)))
-      (let ((cl-n (min (length cl-x) (length cl-y)))
-	    (cl-i -1))
-	(while (< (setq cl-i (1+ cl-i)) cl-n)
-	  (cl-push (funcall cl-func
-			    (if (consp cl-x) (cl-pop cl-x) (aref cl-x cl-i))
-			    (if (consp cl-y) (cl-pop cl-y) (aref cl-y cl-i)))
-		   cl-res)))
-      (nreverse cl-res))))
-
-(defun map (cl-type cl-func cl-seq &rest cl-rest)
-  "Map a function across one or more sequences, returning a sequence.
-TYPE is the sequence type to return, FUNC is the function, and SEQS
-are the argument sequences."
-  (let ((cl-res (apply 'mapcar* cl-func cl-seq cl-rest)))
-    (and cl-type (coerce cl-res cl-type))))
-
-(defun maplist (cl-func cl-list &rest cl-rest)
-  "Map FUNC to each sublist of LIST or LISTS.
-Like `mapcar', except applies to lists and their cdr's rather than to
-the elements themselves."
-  (if cl-rest
-      (let ((cl-res nil)
-	    (cl-args (cons cl-list (copy-sequence cl-rest)))
-	    cl-p)
-	(while (not (memq nil cl-args))
-	  (cl-push (apply cl-func cl-args) cl-res)
-	  (setq cl-p cl-args)
-	  (while cl-p (setcar cl-p (cdr (cl-pop cl-p)) )))
-	(nreverse cl-res))
-    (let ((cl-res nil))
-      (while cl-list
-	(cl-push (funcall cl-func cl-list) cl-res)
-	(setq cl-list (cdr cl-list)))
-      (nreverse cl-res))))
-
-(defun mapc (cl-func cl-seq &rest cl-rest)
-  "Like `mapcar', but does not accumulate values returned by the function."
-  (if cl-rest
-      (apply 'map nil cl-func cl-seq cl-rest)
-    (mapcar cl-func cl-seq))
-  cl-seq)
-
-(defun mapl (cl-func cl-list &rest cl-rest)
-  "Like `maplist', but does not accumulate values returned by the function."
-  (if cl-rest
-      (apply 'maplist cl-func cl-list cl-rest)
-    (let ((cl-p cl-list))
-      (while cl-p (funcall cl-func cl-p) (setq cl-p (cdr cl-p)))))
-  cl-list)
-
-(defun mapcan (cl-func cl-seq &rest cl-rest)
-  "Like `mapcar', but nconc's together the values returned by the function."
-  (apply 'nconc (apply 'mapcar* cl-func cl-seq cl-rest)))
-
-(defun mapcon (cl-func cl-list &rest cl-rest)
-  "Like `maplist', but nconc's together the values returned by the function."
-  (apply 'nconc (apply 'maplist cl-func cl-list cl-rest)))
-
-(defun some (cl-pred cl-seq &rest cl-rest)
-  "Return true if PREDICATE is true of any element of SEQ or SEQs.
-If so, return the true (non-nil) value returned by PREDICATE."
-  (if (or cl-rest (nlistp cl-seq))
-      (catch 'cl-some
-	(apply 'map nil
-	       (function (lambda (&rest cl-x)
-			   (let ((cl-res (apply cl-pred cl-x)))
-			     (if cl-res (throw 'cl-some cl-res)))))
-	       cl-seq cl-rest) nil)
-    (let ((cl-x nil))
-      (while (and cl-seq (not (setq cl-x (funcall cl-pred (cl-pop cl-seq))))))
-      cl-x)))
-
-(defun every (cl-pred cl-seq &rest cl-rest)
-  "Return true if PREDICATE is true of every element of SEQ or SEQs."
-  (if (or cl-rest (nlistp cl-seq))
-      (catch 'cl-every
-	(apply 'map nil
-	       (function (lambda (&rest cl-x)
-			   (or (apply cl-pred cl-x) (throw 'cl-every nil))))
-	       cl-seq cl-rest) t)
-    (while (and cl-seq (funcall cl-pred (car cl-seq)))
-      (setq cl-seq (cdr cl-seq)))
-    (null cl-seq)))
-
-(defun notany (cl-pred cl-seq &rest cl-rest)
-  "Return true if PREDICATE is false of every element of SEQ or SEQs."
-  (not (apply 'some cl-pred cl-seq cl-rest)))
-
-(defun notevery (cl-pred cl-seq &rest cl-rest)
-  "Return true if PREDICATE is false of some element of SEQ or SEQs."
-  (not (apply 'every cl-pred cl-seq cl-rest)))
-
-;;; Support for `loop'.
-(defun cl-map-keymap (cl-func cl-map)
-  (while (symbolp cl-map) (setq cl-map (symbol-function cl-map)))
-  (if (eq cl-emacs-type 'lucid) (funcall 'map-keymap cl-func cl-map)
-    (if (listp cl-map)
-	(let ((cl-p cl-map))
-	  (while (consp (setq cl-p (cdr cl-p)))
-	    (cond ((consp (car cl-p))
-		   (funcall cl-func (car (car cl-p)) (cdr (car cl-p))))
-		  ((vectorp (car cl-p))
-		   (cl-map-keymap cl-func (car cl-p)))
-		  ((eq (car cl-p) 'keymap)
-		   (setq cl-p nil)))))
-      (let ((cl-i -1))
-	(while (< (setq cl-i (1+ cl-i)) (length cl-map))
-	  (if (aref cl-map cl-i)
-	      (funcall cl-func cl-i (aref cl-map cl-i))))))))
-
-(defun cl-map-keymap-recursively (cl-func-rec cl-map &optional cl-base)
-  (or cl-base
-      (setq cl-base (copy-sequence (if (eq cl-emacs-type 18) "0" [0]))))
-  (cl-map-keymap
-   (function
-    (lambda (cl-key cl-bind)
-      (aset cl-base (1- (length cl-base)) cl-key)
-      (if (keymapp cl-bind)
-	  (cl-map-keymap-recursively
-	   cl-func-rec cl-bind
-	   (funcall (if (eq cl-emacs-type 18) 'concat 'vconcat)
-		    cl-base (list 0)))
-	(funcall cl-func-rec cl-base cl-bind))))
-   cl-map))
-
-(defun cl-map-intervals (cl-func &optional cl-what cl-prop cl-start cl-end)
-  (or cl-what (setq cl-what (current-buffer)))
-  (if (bufferp cl-what)
-      (let (cl-mark cl-mark2 (cl-next t) cl-next2)
-	(save-excursion
-	  (set-buffer cl-what)
-	  (setq cl-mark (copy-marker (or cl-start (point-min))))
-	  (setq cl-mark2 (and cl-end (copy-marker cl-end))))
-	(while (and cl-next (or (not cl-mark2) (< cl-mark cl-mark2)))
-	  (setq cl-next (and (fboundp 'next-property-change)
-			     (if cl-prop (next-single-property-change
-					  cl-mark cl-prop cl-what)
-			       (next-property-change cl-mark cl-what)))
-		cl-next2 (or cl-next (save-excursion
-				       (set-buffer cl-what) (point-max))))
-	  (funcall cl-func (prog1 (marker-position cl-mark)
-			     (set-marker cl-mark cl-next2))
-		   (if cl-mark2 (min cl-next2 cl-mark2) cl-next2)))
-	(set-marker cl-mark nil) (if cl-mark2 (set-marker cl-mark2 nil)))
-    (or cl-start (setq cl-start 0))
-    (or cl-end (setq cl-end (length cl-what)))
-    (while (< cl-start cl-end)
-      (let ((cl-next (or (and (fboundp 'next-property-change)
-			      (if cl-prop (next-single-property-change
-					   cl-start cl-prop cl-what)
-				(next-property-change cl-start cl-what)))
-			 cl-end)))
-	(funcall cl-func cl-start (min cl-next cl-end))
-	(setq cl-start cl-next)))))
-
-(defun cl-map-overlays (cl-func &optional cl-buffer cl-start cl-end cl-arg)
-  (or cl-buffer (setq cl-buffer (current-buffer)))
-  (if (fboundp 'overlay-lists)
-
-      ;; This is the preferred algorithm, though overlay-lists is undocumented.
-      (let (cl-ovl)
-	(save-excursion
-	  (set-buffer cl-buffer)
-	  (setq cl-ovl (overlay-lists))
-	  (if cl-start (setq cl-start (copy-marker cl-start)))
-	  (if cl-end (setq cl-end (copy-marker cl-end))))
-	(setq cl-ovl (nconc (car cl-ovl) (cdr cl-ovl)))
-	(while (and cl-ovl
-		    (or (not (overlay-start (car cl-ovl)))
-			(and cl-end (>= (overlay-start (car cl-ovl)) cl-end))
-			(and cl-start (<= (overlay-end (car cl-ovl)) cl-start))
-			(not (funcall cl-func (car cl-ovl) cl-arg))))
-	  (setq cl-ovl (cdr cl-ovl)))
-	(if cl-start (set-marker cl-start nil))
-	(if cl-end (set-marker cl-end nil)))
-
-    ;; This alternate algorithm fails to find zero-length overlays.
-    (let ((cl-mark (save-excursion (set-buffer cl-buffer)
-				   (copy-marker (or cl-start (point-min)))))
-	  (cl-mark2 (and cl-end (save-excursion (set-buffer cl-buffer)
-						(copy-marker cl-end))))
-	  cl-pos cl-ovl)
-      (while (save-excursion
-	       (and (setq cl-pos (marker-position cl-mark))
-		    (< cl-pos (or cl-mark2 (point-max)))
-		    (progn
-		      (set-buffer cl-buffer)
-		      (setq cl-ovl (overlays-at cl-pos))
-		      (set-marker cl-mark (next-overlay-change cl-pos)))))
-	(while (and cl-ovl
-		    (or (/= (overlay-start (car cl-ovl)) cl-pos)
-			(not (and (funcall cl-func (car cl-ovl) cl-arg)
-				  (set-marker cl-mark nil)))))
-	  (setq cl-ovl (cdr cl-ovl))))
-      (set-marker cl-mark nil) (if cl-mark2 (set-marker cl-mark2 nil)))))
-
-;;; Support for `setf'.
-(defun cl-set-frame-visible-p (frame val)
-  (cond ((null val) (make-frame-invisible frame))
-	((eq val 'icon) (iconify-frame frame))
-	(t (make-frame-visible frame)))
-  val)
-
-;;; Support for `progv'.
-(defvar cl-progv-save)
-(defun cl-progv-before (syms values)
-  (while syms
-    (cl-push (if (boundp (car syms))
-		 (cons (car syms) (symbol-value (car syms)))
-	       (car syms)) cl-progv-save)
-    (if values
-	(set (cl-pop syms) (cl-pop values))
-      (makunbound (cl-pop syms)))))
-
-(defun cl-progv-after ()
-  (while cl-progv-save
-    (if (consp (car cl-progv-save))
-	(set (car (car cl-progv-save)) (cdr (car cl-progv-save)))
-      (makunbound (car cl-progv-save)))
-    (cl-pop cl-progv-save)))
-
-
-;;; Numbers.
-
-(defun gcd (&rest args)
-  "Return the greatest common divisor of the arguments."
-  (let ((a (abs (or (cl-pop args) 0))))
-    (while args
-      (let ((b (abs (cl-pop args))))
-	(while (> b 0) (setq b (% a (setq a b))))))
-    a))
-
-(defun lcm (&rest args)
-  "Return the least common multiple of the arguments."
-  (if (memq 0 args)
-      0
-    (let ((a (abs (or (cl-pop args) 1))))
-      (while args
-	(let ((b (abs (cl-pop args))))
-	  (setq a (* (/ a (gcd a b)) b))))
-      a)))
-
-(defun isqrt (a)
-  "Return the integer square root of the argument."
-  (if (and (integerp a) (> a 0))
-      (let ((g (cond ((<= a 100) 10) ((<= a 10000) 100)
-		     ((<= a 1000000) 1000) (t a)))
-	    g2)
-	(while (< (setq g2 (/ (+ g (/ a g)) 2)) g)
-	  (setq g g2))
-	g)
-    (if (eq a 0) 0 (signal 'arith-error nil))))
-
-(defun cl-expt (x y)
-  "Return X raised to the power of Y.  Works only for integer arguments."
-  (if (<= y 0) (if (= y 0) 1 (if (memq x '(-1 1)) (cl-expt x (- y)) 0))
-    (* (if (= (% y 2) 0) 1 x) (cl-expt (* x x) (/ y 2)))))
-(or (and (fboundp 'expt) (subrp (symbol-function 'expt)))
-    (defalias 'expt 'cl-expt))
-
-(defun floor* (x &optional y)
-  "Return a list of the floor of X and the fractional part of X.
-With two arguments, return floor and remainder of their quotient."
-  (let ((q (floor x y)))
-    (list q (- x (if y (* y q) q)))))
-
-(defun ceiling* (x &optional y)
-  "Return a list of the ceiling of X and the fractional part of X.
-With two arguments, return ceiling and remainder of their quotient."
-  (let ((res (floor* x y)))
-    (if (= (car (cdr res)) 0) res
-      (list (1+ (car res)) (- (car (cdr res)) (or y 1))))))
-
-(defun truncate* (x &optional y)
-  "Return a list of the integer part of X and the fractional part of X.
-With two arguments, return truncation and remainder of their quotient."
-  (if (eq (>= x 0) (or (null y) (>= y 0)))
-      (floor* x y) (ceiling* x y)))
-
-(defun round* (x &optional y)
-  "Return a list of X rounded to the nearest integer and the remainder.
-With two arguments, return rounding and remainder of their quotient."
-  (if y
-      (if (and (integerp x) (integerp y))
-	  (let* ((hy (/ y 2))
-		 (res (floor* (+ x hy) y)))
-	    (if (and (= (car (cdr res)) 0)
-		     (= (+ hy hy) y)
-		     (/= (% (car res) 2) 0))
-		(list (1- (car res)) hy)
-	      (list (car res) (- (car (cdr res)) hy))))
-	(let ((q (round (/ x y))))
-	  (list q (- x (* q y)))))
-    (if (integerp x) (list x 0)
-      (let ((q (round x)))
-	(list q (- x q))))))
-
-(defun mod* (x y)
-  "The remainder of X divided by Y, with the same sign as Y."
-  (nth 1 (floor* x y)))
-
-(defun rem* (x y)
-  "The remainder of X divided by Y, with the same sign as X."
-  (nth 1 (truncate* x y)))
-
-(defun signum (a)
-  "Return 1 if A is positive, -1 if negative, 0 if zero."
-  (cond ((> a 0) 1) ((< a 0) -1) (t 0)))
-
-
-;; Random numbers.
-
-(defvar *random-state*)
-(defun random* (lim &optional state)
-  "Return a random nonnegative number less than LIM, an integer or float.
-Optional second arg STATE is a random-state object."
-  (or state (setq state *random-state*))
-  ;; Inspired by "ran3" from Numerical Recipes.  Additive congruential method.
-  (let ((vec (aref state 3)))
-    (if (integerp vec)
-	(let ((i 0) (j (- 1357335 (% (abs vec) 1357333))) (k 1) ii)
-	  (aset state 3 (setq vec (make-vector 55 nil)))
-	  (aset vec 0 j)
-	  (while (> (setq i (% (+ i 21) 55)) 0)
-	    (aset vec i (setq j (prog1 k (setq k (- j k))))))
-	  (while (< (setq i (1+ i)) 200) (random* 2 state))))
-    (let* ((i (aset state 1 (% (1+ (aref state 1)) 55)))
-	   (j (aset state 2 (% (1+ (aref state 2)) 55)))
-	   (n (logand 8388607 (aset vec i (- (aref vec i) (aref vec j))))))
-      (if (integerp lim)
-	  (if (<= lim 512) (% n lim)
-	    (if (> lim 8388607) (setq n (+ (lsh n 9) (random* 512 state))))
-	    (let ((mask 1023))
-	      (while (< mask (1- lim)) (setq mask (1+ (+ mask mask))))
-	      (if (< (setq n (logand n mask)) lim) n (random* lim state))))
-	(* (/ n '8388608e0) lim)))))
-
-(defun make-random-state (&optional state)
-  "Return a copy of random-state STATE, or of `*random-state*' if omitted.
-If STATE is t, return a new state object seeded from the time of day."
-  (cond ((null state) (make-random-state *random-state*))
-	((vectorp state) (cl-copy-tree state t))
-	((integerp state) (vector 'cl-random-state-tag -1 30 state))
-	(t (make-random-state (cl-random-time)))))
-
-(defun random-state-p (object)
-  "Return t if OBJECT is a random-state object."
-  (and (vectorp object) (= (length object) 4)
-       (eq (aref object 0) 'cl-random-state-tag)))
-
-
-;; Implementation limits.
-
-(defun cl-finite-do (func a b)
-  (condition-case err
-      (let ((res (funcall func a b)))   ; check for IEEE infinity
-	(and (numberp res) (/= res (/ res 2)) res))
-    (arith-error nil)))
-
-(defvar most-positive-float)
-(defvar most-negative-float)
-(defvar least-positive-float)
-(defvar least-negative-float)
-(defvar least-positive-normalized-float)
-(defvar least-negative-normalized-float)
-(defvar float-epsilon)
-(defvar float-negative-epsilon)
-
-(defun cl-float-limits ()
-  (or most-positive-float (not (numberp '2e1))
-      (let ((x '2e0) y z)
-	;; Find maximum exponent (first two loops are optimizations)
-	(while (cl-finite-do '* x x) (setq x (* x x)))
-	(while (cl-finite-do '* x (/ x 2)) (setq x (* x (/ x 2))))
-	(while (cl-finite-do '+ x x) (setq x (+ x x)))
-	(setq z x y (/ x 2))
-	;; Now fill in 1's in the mantissa.
-	(while (and (cl-finite-do '+ x y) (/= (+ x y) x))
-	  (setq x (+ x y) y (/ y 2)))
-	(setq most-positive-float x
-	      most-negative-float (- x))
-	;; Divide down until mantissa starts rounding.
-	(setq x (/ x z) y (/ 16 z) x (* x y))
-	(while (condition-case err (and (= x (* (/ x 2) 2)) (> (/ y 2) 0))
-		 (arith-error nil))
-	  (setq x (/ x 2) y (/ y 2)))
-	(setq least-positive-normalized-float y
-	      least-negative-normalized-float (- y))
-	;; Divide down until value underflows to zero.
-	(setq x (/ 1 z) y x)
-	(while (condition-case err (> (/ x 2) 0) (arith-error nil))
-	  (setq x (/ x 2)))
-	(setq least-positive-float x
-	      least-negative-float (- x))
-	(setq x '1e0)
-	(while (/= (+ '1e0 x) '1e0) (setq x (/ x 2)))
-	(setq float-epsilon (* x 2))
-	(setq x '1e0)
-	(while (/= (- '1e0 x) '1e0) (setq x (/ x 2)))
-	(setq float-negative-epsilon (* x 2))))
-  nil)
-
-
-;;; Sequence functions.
-
-(defun subseq (seq start &optional end)
-  "Return the subsequence of SEQ from START to END.
-If END is omitted, it defaults to the length of the sequence.
-If START or END is negative, it counts from the end."
-  (if (stringp seq) (substring seq start end)
-    (let (len)
-      (and end (< end 0) (setq end (+ end (setq len (length seq)))))
-      (if (< start 0) (setq start (+ start (or len (setq len (length seq))))))
-      (cond ((listp seq)
-	     (if (> start 0) (setq seq (nthcdr start seq)))
-	     (if end
-		 (let ((res nil))
-		   (while (>= (setq end (1- end)) start)
-		     (cl-push (cl-pop seq) res))
-		   (nreverse res))
-	       (copy-sequence seq)))
-	    (t
-	     (or end (setq end (or len (length seq))))
-	     (let ((res (make-vector (max (- end start) 0) nil))
-		   (i 0))
-	       (while (< start end)
-		 (aset res i (aref seq start))
-		 (setq i (1+ i) start (1+ start)))
-	       res))))))
-
-(defun concatenate (type &rest seqs)
-  "Concatenate, into a sequence of type TYPE, the argument SEQUENCES."
-  (cond ((eq type 'vector) (apply 'vconcat seqs))
-	((eq type 'string) (apply 'concat seqs))
-	((eq type 'list) (apply 'append (append seqs '(nil))))
-	(t (error "Not a sequence type name: %s" type))))
-
-
-;;; List functions.
-
-(defun revappend (x y)
-  "Equivalent to (append (reverse X) Y)."
-  (nconc (reverse x) y))
-
-(defun nreconc (x y)
-  "Equivalent to (nconc (nreverse X) Y)."
-  (nconc (nreverse x) y))
-
-(defun list-length (x)
-  "Return the length of a list.  Return nil if list is circular."
-  (let ((n 0) (fast x) (slow x))
-    (while (and (cdr fast) (not (and (eq fast slow) (> n 0))))
-      (setq n (+ n 2) fast (cdr (cdr fast)) slow (cdr slow)))
-    (if fast (if (cdr fast) nil (1+ n)) n)))
-
-(defun tailp (sublist list)
-  "Return true if SUBLIST is a tail of LIST."
-  (while (and (consp list) (not (eq sublist list)))
-    (setq list (cdr list)))
-  (if (numberp sublist) (equal sublist list) (eq sublist list)))
-
-(defun cl-copy-tree (tree &optional vecp)
-  "Make a copy of TREE.
-If TREE is a cons cell, this recursively copies both its car and its cdr.
-Contrast to copy-sequence, which copies only along the cdrs.  With second
-argument VECP, this copies vectors as well as conses."
-  (if (consp tree)
-      (let ((p (setq tree (copy-list tree))))
-	(while (consp p)
-	  (if (or (consp (car p)) (and vecp (vectorp (car p))))
-	      (setcar p (cl-copy-tree (car p) vecp)))
-	  (or (listp (cdr p)) (setcdr p (cl-copy-tree (cdr p) vecp)))
-	  (cl-pop p)))
-    (if (and vecp (vectorp tree))
-	(let ((i (length (setq tree (copy-sequence tree)))))
-	  (while (>= (setq i (1- i)) 0)
-	    (aset tree i (cl-copy-tree (aref tree i) vecp))))))
-  tree)
-(or (and (fboundp 'copy-tree) (subrp (symbol-function 'copy-tree)))
-    (defalias 'copy-tree 'cl-copy-tree))
-
-
-;;; Property lists.
-
-(defun get* (sym tag &optional def)    ; See compiler macro in cl-macs.el
-  "Return the value of SYMBOL's PROPNAME property, or DEFAULT if none."
-  (or (get sym tag)
-      (and def
-	   (let ((plist (symbol-plist sym)))
-	     (while (and plist (not (eq (car plist) tag)))
-	       (setq plist (cdr (cdr plist))))
-	     (if plist (car (cdr plist)) def)))))
-
-(defun getf (plist tag &optional def)
-  "Search PROPLIST for property PROPNAME; return its value or DEFAULT.
-PROPLIST is a list of the sort returned by `symbol-plist'."
-  (setplist '--cl-getf-symbol-- plist)
-  (or (get '--cl-getf-symbol-- tag)
-      (and def (get* '--cl-getf-symbol-- tag def))))
-
-(defun cl-set-getf (plist tag val)
-  (let ((p plist))
-    (while (and p (not (eq (car p) tag))) (setq p (cdr (cdr p))))
-    (if p (progn (setcar (cdr p) val) plist) (list* tag val plist))))
-
-(defun cl-do-remf (plist tag)
-  (let ((p (cdr plist)))
-    (while (and (cdr p) (not (eq (car (cdr p)) tag))) (setq p (cdr (cdr p))))
-    (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t))))
-
-(defun cl-remprop (sym tag)
-  "Remove from SYMBOL's plist the property PROP and its value."
-  (let ((plist (symbol-plist sym)))
-    (if (and plist (eq tag (car plist)))
-	(progn (setplist sym (cdr (cdr plist))) t)
-      (cl-do-remf plist tag))))
-(or (and (fboundp 'remprop) (subrp (symbol-function 'remprop)))
-    (defalias 'remprop 'cl-remprop))
-
-
-
-;;; Hash tables.
-
-(defun make-hash-table (&rest cl-keys)
-  "Make an empty Common Lisp-style hash-table.
-If :test is `eq', this can use Lucid Emacs built-in hash-tables.
-In non-Lucid Emacs, or with non-`eq' test, this internally uses a-lists.
-Keywords supported:  :test :size
-The Common Lisp keywords :rehash-size and :rehash-threshold are ignored."
-  (let ((cl-test (or (car (cdr (memq ':test cl-keys))) 'eql))
-	(cl-size (or (car (cdr (memq ':size cl-keys))) 20)))
-    (if (and (eq cl-test 'eq) (fboundp 'make-hashtable))
-	(funcall 'make-hashtable cl-size)
-      (list 'cl-hash-table-tag cl-test
-	    (if (> cl-size 1) (make-vector cl-size 0)
-	      (let ((sym (make-symbol "--hashsym--"))) (set sym nil) sym))
-	    0))))
-
-(defvar cl-lucid-hash-tag
-  (if (and (fboundp 'make-hashtable) (vectorp (make-hashtable 1)))
-      (aref (make-hashtable 1) 0) (make-symbol "--cl-hash-tag--")))
-
-(defun hash-table-p (x)
-  "Return t if OBJECT is a hash table."
-  (or (eq (car-safe x) 'cl-hash-table-tag)
-      (and (vectorp x) (= (length x) 4) (eq (aref x 0) cl-lucid-hash-tag))
-      (and (fboundp 'hashtablep) (funcall 'hashtablep x))))
-
-(defun cl-not-hash-table (x &optional y &rest z)
-  (signal 'wrong-type-argument (list 'hash-table-p (or y x))))
-
-(defun cl-hash-lookup (key table)
-  (or (eq (car-safe table) 'cl-hash-table-tag) (cl-not-hash-table table))
-  (let* ((array (nth 2 table)) (test (car (cdr table))) (str key) sym)
-    (if (symbolp array) (setq str nil sym (symbol-value array))
-      (while (or (consp str) (and (vectorp str) (> (length str) 0)))
-	(setq str (elt str 0)))
-      (cond ((stringp str) (if (eq test 'equalp) (setq str (downcase str))))
-	    ((symbolp str) (setq str (symbol-name str)))
-	    ((and (numberp str) (> str -8000000) (< str 8000000))
-	     (or (integerp str) (setq str (truncate str)))
-	     (setq str (aref ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10"
-			      "11" "12" "13" "14" "15"] (logand str 15))))
-	    (t (setq str "*")))
-      (setq sym (symbol-value (intern-soft str array))))
-    (list (and sym (cond ((or (eq test 'eq)
-			      (and (eq test 'eql) (not (numberp key))))
-			  (assq key sym))
-			 ((memq test '(eql equal)) (assoc key sym))
-			 (t (assoc* key sym ':test test))))
-	  sym str)))
-
-(defvar cl-builtin-gethash
-  (if (and (fboundp 'gethash) (subrp (symbol-function 'gethash)))
-      (symbol-function 'gethash) 'cl-not-hash-table))
-(defvar cl-builtin-remhash
-  (if (and (fboundp 'remhash) (subrp (symbol-function 'remhash)))
-      (symbol-function 'remhash) 'cl-not-hash-table))
-(defvar cl-builtin-clrhash
-  (if (and (fboundp 'clrhash) (subrp (symbol-function 'clrhash)))
-      (symbol-function 'clrhash) 'cl-not-hash-table))
-(defvar cl-builtin-maphash
-  (if (and (fboundp 'maphash) (subrp (symbol-function 'maphash)))
-      (symbol-function 'maphash) 'cl-not-hash-table))
-
-(defun cl-gethash (key table &optional def)
-  "Look up KEY in HASH-TABLE; return corresponding value, or DEFAULT."
-  (if (consp table)
-      (let ((found (cl-hash-lookup key table)))
-	(if (car found) (cdr (car found)) def))
-    (funcall cl-builtin-gethash key table def)))
-(defalias 'gethash 'cl-gethash)
-
-(defun cl-puthash (key val table)
-  (if (consp table)
-      (let ((found (cl-hash-lookup key table)))
-	(if (car found) (setcdr (car found) val)
-	  (if (nth 2 found)
-	      (progn
-		(if (> (nth 3 table) (* (length (nth 2 table)) 3))
-		    (let ((new-table (make-vector (nth 3 table) 0)))
-		      (mapatoms (function
-				 (lambda (sym)
-				   (set (intern (symbol-name sym) new-table)
-					(symbol-value sym))))
-				(nth 2 table))
-		      (setcar (cdr (cdr table)) new-table)))
-		(set (intern (nth 2 found) (nth 2 table))
-		     (cons (cons key val) (nth 1 found))))
-	    (set (nth 2 table) (cons (cons key val) (nth 1 found))))
-	  (setcar (cdr (cdr (cdr table))) (1+ (nth 3 table)))))
-    (funcall 'puthash key val table)) val)
-
-(defun cl-remhash (key table)
-  "Remove KEY from HASH-TABLE."
-  (if (consp table)
-      (let ((found (cl-hash-lookup key table)))
-	(and (car found)
-	     (let ((del (delq (car found) (nth 1 found))))
-	       (setcar (cdr (cdr (cdr table))) (1- (nth 3 table)))
-	       (if (nth 2 found) (set (intern (nth 2 found) (nth 2 table)) del)
-		 (set (nth 2 table) del)) t)))
-    (prog1 (not (eq (funcall cl-builtin-gethash key table '--cl--) '--cl--))
-      (funcall cl-builtin-remhash key table))))
-(defalias 'remhash 'cl-remhash)
-
-(defun cl-clrhash (table)
-  "Clear HASH-TABLE."
-  (if (consp table)
-      (progn
-	(or (hash-table-p table) (cl-not-hash-table table))
-	(if (symbolp (nth 2 table)) (set (nth 2 table) nil)
-	  (setcar (cdr (cdr table)) (make-vector (length (nth 2 table)) 0)))
-	(setcar (cdr (cdr (cdr table))) 0))
-    (funcall cl-builtin-clrhash table))
-  nil)
-(defalias 'clrhash 'cl-clrhash)
-
-(defun cl-maphash (cl-func cl-table)
-  "Call FUNCTION on keys and values from HASH-TABLE."
-  (or (hash-table-p cl-table) (cl-not-hash-table cl-table))
-  (if (consp cl-table)
-      (mapatoms (function (lambda (cl-x)
-			    (setq cl-x (symbol-value cl-x))
-			    (while cl-x
-			      (funcall cl-func (car (car cl-x))
-				       (cdr (car cl-x)))
-			      (setq cl-x (cdr cl-x)))))
-		(if (symbolp (nth 2 cl-table))
-		    (vector (nth 2 cl-table)) (nth 2 cl-table)))
-    (funcall cl-builtin-maphash cl-func cl-table)))
-(defalias 'maphash 'cl-maphash)
-
-(defun hash-table-count (table)
-  "Return the number of entries in HASH-TABLE."
-  (or (hash-table-p table) (cl-not-hash-table table))
-  (if (consp table) (nth 3 table) (funcall 'hashtable-fullness table)))
-
-
-;;; Some debugging aids.
-
-(defun cl-prettyprint (form)
-  "Insert a pretty-printed rendition of a Lisp FORM in current buffer."
-  (let ((pt (point)) last)
-    (insert "\n" (prin1-to-string form) "\n")
-    (setq last (point))
-    (goto-char (1+ pt))
-    (while (search-forward "(quote " last t)
-      (delete-backward-char 7)
-      (insert "'")
-      (forward-sexp)
-      (delete-char 1))
-    (goto-char (1+ pt))
-    (cl-do-prettyprint)))
-
-(defun cl-do-prettyprint ()
-  (skip-chars-forward " ")
-  (if (looking-at "(")
-      (let ((skip (or (looking-at "((") (looking-at "(prog")
-		      (looking-at "(unwind-protect ")
-		      (looking-at "(function (")
-		      (looking-at "(cl-block-wrapper ")))
-	    (two (or (looking-at "(defun ") (looking-at "(defmacro ")))
-	    (let (or (looking-at "(let\\*? ") (looking-at "(while ")))
-	    (set (looking-at "(p?set[qf] ")))
-	(if (or skip let
-		(progn
-		  (forward-sexp)
-		  (and (>= (current-column) 78) (progn (backward-sexp) t))))
-	    (let ((nl t))
-	      (forward-char 1)
-	      (cl-do-prettyprint)
-	      (or skip (looking-at ")") (cl-do-prettyprint))
-	      (or (not two) (looking-at ")") (cl-do-prettyprint))
-	      (while (not (looking-at ")"))
-		(if set (setq nl (not nl)))
-		(if nl (insert "\n"))
-		(lisp-indent-line)
-		(cl-do-prettyprint))
-	      (forward-char 1))))
-    (forward-sexp)))
-
-(defvar cl-macroexpand-cmacs nil)
-(defvar cl-closure-vars nil)
-
-(defun cl-macroexpand-all (form &optional env)
-  "Expand all macro calls through a Lisp FORM.
-This also does some trivial optimizations to make the form prettier."
-  (while (or (not (eq form (setq form (macroexpand form env))))
-	     (and cl-macroexpand-cmacs
-		  (not (eq form (setq form (compiler-macroexpand form)))))))
-  (cond ((not (consp form)) form)
-	((memq (car form) '(let let*))
-	 (if (null (nth 1 form))
-	     (cl-macroexpand-all (cons 'progn (cddr form)) env)
-	   (let ((letf nil) (res nil) (lets (cadr form)))
-	     (while lets
-	       (cl-push (if (consp (car lets))
-			    (let ((exp (cl-macroexpand-all (caar lets) env)))
-			      (or (symbolp exp) (setq letf t))
-			      (cons exp (cl-macroexpand-body (cdar lets) env)))
-			  (let ((exp (cl-macroexpand-all (car lets) env)))
-			    (if (symbolp exp) exp
-			      (setq letf t) (list exp nil)))) res)
-	       (setq lets (cdr lets)))
-	     (list* (if letf (if (eq (car form) 'let) 'letf 'letf*) (car form))
-		    (nreverse res) (cl-macroexpand-body (cddr form) env)))))
-	((eq (car form) 'cond)
-	 (cons (car form)
-	       (mapcar (function (lambda (x) (cl-macroexpand-body x env)))
-		       (cdr form))))
-	((eq (car form) 'condition-case)
-	 (list* (car form) (nth 1 form) (cl-macroexpand-all (nth 2 form) env)
-		(mapcar (function
-			 (lambda (x)
-			   (cons (car x) (cl-macroexpand-body (cdr x) env))))
-			(cdddr form))))
-	((memq (car form) '(quote function))
-	 (if (eq (car-safe (nth 1 form)) 'lambda)
-	     (let ((body (cl-macroexpand-body (cddadr form) env)))
-	       (if (and cl-closure-vars (eq (car form) 'function)
-			(cl-expr-contains-any body cl-closure-vars))
-		   (let* ((new (mapcar 'gensym cl-closure-vars))
-			  (sub (pairlis cl-closure-vars new)) (decls nil))
-		     (while (or (stringp (car body))
-				(eq (car-safe (car body)) 'interactive))
-		       (cl-push (list 'quote (cl-pop body)) decls))
-		     (put (car (last cl-closure-vars)) 'used t)
-		     (append
-		      (list 'list '(quote lambda) '(quote (&rest --cl-rest--)))
-		      (sublis sub (nreverse decls))
-		      (list
-		       (list* 'list '(quote apply)
-			      (list 'list '(quote quote)
-				    (list 'function
-					  (list* 'lambda
-						 (append new (cadadr form))
-						 (sublis sub body))))
-			      (nconc (mapcar (function
-					      (lambda (x)
-						(list 'list '(quote quote) x)))
-					     cl-closure-vars)
-				     '((quote --cl-rest--)))))))
-		 (list (car form) (list* 'lambda (cadadr form) body))))
-	   (let ((found (assq (cadr form) env)))
-	     (if (eq (cadr (caddr found)) 'cl-labels-args)
-		 (cl-macroexpand-all (cadr (caddr (cadddr found))) env)
-	       form))))
-	((memq (car form) '(defun defmacro))
-	 (list* (car form) (nth 1 form) (cl-macroexpand-body (cddr form) env)))
-	((and (eq (car form) 'progn) (not (cddr form)))
-	 (cl-macroexpand-all (nth 1 form) env))
-	((eq (car form) 'setq)
-	 (let* ((args (cl-macroexpand-body (cdr form) env)) (p args))
-	   (while (and p (symbolp (car p))) (setq p (cddr p)))
-	   (if p (cl-macroexpand-all (cons 'setf args)) (cons 'setq args))))
-	(t (cons (car form) (cl-macroexpand-body (cdr form) env)))))
-
-(defun cl-macroexpand-body (body &optional env)
-  (mapcar (function (lambda (x) (cl-macroexpand-all x env))) body))
-
-(defun cl-prettyexpand (form &optional full)
-  (message "Expanding...")
-  (let ((cl-macroexpand-cmacs full) (cl-compiling-file full)
-	(byte-compile-macro-environment nil))
-    (setq form (cl-macroexpand-all form
-				   (and (not full) '((block) (eval-when)))))
-    (message "Formatting...")
-    (prog1 (cl-prettyprint form)
-      (message ""))))
-
-
-
-(run-hooks 'cl-extra-load-hook)
-
-;;; cl-extra.el ends here
diff --git a/lisp/emacs-lisp/cl-indent.el b/lisp/emacs-lisp/cl-indent.el
deleted file mode 100644
index 8d199c14452..00000000000
--- a/lisp/emacs-lisp/cl-indent.el
+++ /dev/null
@@ -1,474 +0,0 @@
-;;; cl-indent.el --- enhanced lisp-indent mode
-
-;; Copyright (C) 1987 Free Software Foundation, Inc.
-
-;; Author: Richard Mlynarik <mly@eddie.mit.edu>
-;; Created: July 1987
-;; Maintainer: FSF
-;; Keywords: lisp, tools
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This package supplies a single entry point, common-lisp-indent-function,
-;; which performs indentation in the preferred style for Common Lisp code.
-;; To enable it:
-;;
-;; (setq lisp-indent-function 'common-lisp-indent-function)
-
-;;>> TODO
-;; :foo
-;;   bar
-;; :baz
-;;   zap
-;; &key (like &body)??
-
-;; &rest 1 in lambda-lists doesn't work
-;;  -- really want (foo bar
-;;                  baz)
-;;     not (foo bar
-;;              baz)
-;;  Need something better than &rest for such cases
-
-;;; Code:
-
-(defvar lisp-indent-maximum-backtracking 3
-  "*Maximum depth to backtrack out from a sublist for structured indentation.
-If this variable is  0, no backtracking will occur and forms such as flet
-may not be correctly indented.")
-
-(defvar lisp-tag-indentation 1
-  "*Indentation of tags relative to containing list.
-This variable is used by the function `lisp-indent-tagbody'.")
-
-(defvar lisp-tag-body-indentation 3
-  "*Indentation of non-tagged lines relative to containing list.
-This variable is used by the function `lisp-indent-tagbody' to indent normal
-lines (lines without tags).
-The indentation is relative to the indentation of the parenthesis enclosing
-the special form.  If the value is t, the body of tags will be indented
-as a block at the same indentation as the first s-expression following
-the tag.  In this case, any forms before the first tag are indented
-by `lisp-body-indent'.")
-
-
-;;;###autoload
-(defun common-lisp-indent-function (indent-point state)
-  (let ((normal-indent (current-column)))
-    ;; Walk up list levels until we see something
-    ;;  which does special things with subforms.
-    (let ((depth 0)
-          ;; Path describes the position of point in terms of
-          ;;  list-structure with respect to containing lists.
-          ;; `foo' has a path of (0 4 1) in `((a b c (d foo) f) g)'
-          (path ())
-          ;; set non-nil when somebody works out the indentation to use
-          calculated
-          (last-point indent-point)
-          ;; the position of the open-paren of the innermost containing list
-          (containing-form-start (elt state 1))
-          ;; the column of the above
-          sexp-column)
-      ;; Move to start of innermost containing list
-      (goto-char containing-form-start)
-      (setq sexp-column (current-column))
-      ;; Look over successively less-deep containing forms
-      (while (and (not calculated)
-                  (< depth lisp-indent-maximum-backtracking))
-        (let ((containing-sexp (point)))
-          (forward-char 1)
-          (parse-partial-sexp (point) indent-point 1 t)
-          ;; Move to the car of the relevant containing form
-          (let (tem function method)
-            (if (not (looking-at "\\sw\\|\\s_"))
-                ;; This form doesn't seem to start with a symbol
-                (setq function nil method nil)
-              (setq tem (point))
-              (forward-sexp 1)
-              (setq function (downcase (buffer-substring tem (point))))
-              (goto-char tem)
-              (setq tem (intern-soft function)
-                    method (get tem 'common-lisp-indent-function))
-              (cond ((and (null method)
-                          (string-match ":[^:]+" function))
-                     ;; The pleblisp package feature
-                     (setq function (substring function
-                                               (1+ (match-beginning 0)))
-                           method (get (intern-soft function)
-                                       'common-lisp-indent-function)))
-                    ((and (null method))
-                     ;; backwards compatibility
-                     (setq method (get tem 'lisp-indent-function)))))
-            (let ((n 0))
-              ;; How far into the containing form is the current form?
-              (if (< (point) indent-point)
-                  (while (condition-case ()
-                             (progn
-                               (forward-sexp 1)
-                               (if (>= (point) indent-point)
-                                   nil
-                                 (parse-partial-sexp (point)
-                                                     indent-point 1 t)
-                                 (setq n (1+ n))
-                                 t))
-                           (error nil))))
-              (setq path (cons n path)))
-
-            ;; backwards compatibility.
-            (cond ((null function))
-                  ((null method)
-                   (if (null (cdr path))
-                       ;; (package prefix was stripped off above)
-                       (setq method (cond ((string-match "\\`def"
-                                                         function)
-                                           '(4 (&whole 4 &rest 1) &body))
-                                          ((string-match "\\`\\(with\\|do\\)-"
-                                                         function)
-                                           '(4 &body))))))
-                  ;; backwards compatibility.  Bletch.
-                  ((eq method 'defun)
-                   (setq method '(4 (&whole 4 &rest 1) &body))))
-
-            (cond ((and (memq (char-after (1- containing-sexp)) '(?\' ?\`))
-                        (not (eql (char-after (- containing-sexp 2)) ?\#)))
-                   ;; No indentation for "'(...)" elements
-                   (setq calculated (1+ sexp-column)))
-		  ((or (eql (char-after (1- containing-sexp)) ?\,)
-		       (and (eql (char-after (1- containing-sexp)) ?\@)
-			    (eql (char-after (- containing-sexp 2)) ?\,)))
-		   ;; ",(...)" or ",@(...)"
-		   (setq calculated normal-indent))
-                  ((eql (char-after (1- containing-sexp)) ?\#)
-                   ;; "#(...)"
-                   (setq calculated (1+ sexp-column)))
-                  ((null method))
-                  ((integerp method)
-                   ;; convenient top-level hack.
-                   ;;  (also compatible with lisp-indent-function)
-                   ;; The number specifies how many `distinguished'
-                   ;;  forms there are before the body starts
-                   ;; Equivalent to (4 4 ... &body)
-                   (setq calculated (cond ((cdr path)
-                                           normal-indent)
-                                          ((<= (car path) method)
-                                           ;; `distinguished' form
-                                           (list (+ sexp-column 4)
-                                                 containing-form-start))
-                                          ((= (car path) (1+ method))
-                                           ;; first body form.
-                                           (+ sexp-column lisp-body-indent))
-                                          (t
-                                           ;; other body form
-                                           normal-indent))))
-                  ((symbolp method)
-                   (setq calculated (funcall method
-                                             path state indent-point
-                                             sexp-column normal-indent)))
-                  (t
-                   (setq calculated (lisp-indent-259
-                                      method path state indent-point
-                                      sexp-column normal-indent)))))
-          (goto-char containing-sexp)
-          (setq last-point containing-sexp)
-          (if (not calculated)
-              (condition-case ()
-                   (progn (backward-up-list 1)
-                          (setq depth (1+ depth)))
-                (error (setq depth lisp-indent-maximum-backtracking))))))
-      calculated)))
-
-
-(defun lisp-indent-report-bad-format (m)
-  (error "%s has a badly-formed %s property: %s"
-         ;; Love those free variable references!!
-         function 'common-lisp-indent-function m))
-
-;; Blame the crufty control structure on dynamic scoping
-;;  -- not on me!
-(defun lisp-indent-259 (method path state indent-point
-                        sexp-column normal-indent)
-  (catch 'exit
-    (let ((p path)
-          (containing-form-start (elt state 1))
-          n tem tail)
-      ;; Isn't tail-recursion wonderful?
-      (while p
-        ;; This while loop is for destructuring.
-        ;; p is set to (cdr p) each iteration.
-        (if (not (consp method)) (lisp-indent-report-bad-format method))
-        (setq n (1- (car p))
-              p (cdr p)
-              tail nil)
-        (while n
-          ;; This while loop is for advancing along a method
-          ;; until the relevant (possibly &rest/&body) pattern
-          ;; is reached.
-          ;; n is set to (1- n) and method to (cdr method)
-          ;; each iteration.
-          (setq tem (car method))
-
-          (or (eq tem 'nil)             ;default indentation
-;             (eq tem '&lambda)         ;abbrev for (&whole 4 (&rest 1))
-              (and (eq tem '&body) (null (cdr method)))
-              (and (eq tem '&rest)
-                   (consp (cdr method)) (null (cdr (cdr method))))
-              (integerp tem)            ;explicit indentation specified
-              (and (consp tem)          ;destructuring
-                   (eq (car tem) '&whole)
-                   (or (symbolp (car (cdr tem)))
-                       (integerp (car (cdr tem)))))
-              (and (symbolp tem)        ;a function to call to do the work.
-                   (null (cdr method)))
-              (lisp-indent-report-bad-format method))
-
-          (cond ((and tail (not (consp tem)))
-                 ;; indent tail of &rest in same way as first elt of rest
-                 (throw 'exit normal-indent))
-                ((eq tem '&body)
-                 ;; &body means (&rest <lisp-body-indent>)
-                 (throw 'exit
-                   (if (and (= n 0)     ;first body form
-                            (null p))   ;not in subforms
-                       (+ sexp-column
-                          lisp-body-indent)
-                       normal-indent)))
-                ((eq tem '&rest)
-                 ;; this pattern holds for all remaining forms
-                 (setq tail (> n 0)
-                       n 0
-                       method (cdr method)))
-                ((> n 0)
-                 ;; try next element of pattern
-                 (setq n (1- n)
-                       method (cdr method))
-                 (if (< n 0)
-                     ;; Too few elements in pattern.
-                     (throw 'exit normal-indent)))
-                ((eq tem 'nil)
-                 (throw 'exit (list normal-indent containing-form-start)))
-;               ((eq tem '&lambda)
-;                ;; abbrev for (&whole 4 &rest 1)
-;                (throw 'exit
-;                  (cond ((null p)
-;                         (list (+ sexp-column 4) containing-form-start))
-;                        ((null (cdr p))
-;                         (+ sexp-column 1))
-;                        (t normal-indent))))
-                ((integerp tem)
-                 (throw 'exit
-                   (if (null p)         ;not in subforms
-                       (list (+ sexp-column tem) containing-form-start)
-                       normal-indent)))
-                ((symbolp tem)          ;a function to call
-                 (throw 'exit
-                   (funcall tem path state indent-point
-                            sexp-column normal-indent)))
-                (t
-                 ;; must be a destructing frob
-                 (if (not (null p))
-                     ;; descend
-                     (setq method (cdr (cdr tem))
-                           n nil)
-                   (setq tem (car (cdr tem)))
-                   (throw 'exit
-                     (cond (tail
-                            normal-indent)
-                           ((eq tem 'nil)
-                            (list normal-indent
-                                  containing-form-start))
-                           ((integerp tem)
-                            (list (+ sexp-column tem)
-                                  containing-form-start))
-                           (t
-                            (funcall tem path state indent-point
-                                     sexp-column normal-indent))))))))))))
-
-(defun lisp-indent-tagbody (path state indent-point sexp-column normal-indent)
-  (if (not (null (cdr path)))
-      normal-indent
-    (save-excursion
-      (goto-char indent-point)
-      (beginning-of-line)
-      (skip-chars-forward " \t")
-      (list (cond ((looking-at "\\sw\\|\\s_")
-                   ;; a tagbody tag
-                   (+ sexp-column lisp-tag-indentation))
-                  ((integerp lisp-tag-body-indentation)
-                   (+ sexp-column lisp-tag-body-indentation))
-                  ((eq lisp-tag-body-indentation 't)
-                   (condition-case ()
-                       (progn (backward-sexp 1) (current-column))
-                     (error (1+ sexp-column))))
-                  (t (+ sexp-column lisp-body-indent)))
-;            (cond ((integerp lisp-tag-body-indentation)
-;                   (+ sexp-column lisp-tag-body-indentation))
-;                  ((eq lisp-tag-body-indentation 't)
-;                   normal-indent)
-;                  (t
-;                   (+ sexp-column lisp-body-indent)))
-            (elt state 1)
-            ))))
-
-(defun lisp-indent-do (path state indent-point sexp-column normal-indent)
-  (if (>= (car path) 3)
-      (let ((lisp-tag-body-indentation lisp-body-indent))
-        (funcall (function lisp-indent-tagbody)
-		 path state indent-point sexp-column normal-indent))
-    (funcall (function lisp-indent-259)
-	     '((&whole nil &rest
- 		;; the following causes weird indentation
- 		;;(&whole 1 1 2 nil)
-		)
-	       (&whole nil &rest 1))
-	     path state indent-point sexp-column normal-indent)))
-
-(defun lisp-indent-function-lambda-hack (path state indent-point
-                                         sexp-column normal-indent)
-  ;; indent (function (lambda () <newline> <body-forms>)) kludgily.
-  (if (or (cdr path) ; wtf?
-          (> (car path) 3))
-      ;; line up under previous body form
-      normal-indent
-    ;; line up under function rather than under lambda in order to
-    ;;  conserve horizontal space.  (Which is what #' is for.)
-    (condition-case ()
-        (save-excursion
-          (backward-up-list 2)
-          (forward-char 1)
-          (if (looking-at "\\(lisp:+\\)?function\\(\\Sw\\|\\S_\\)")
-              (+ lisp-body-indent -1 (current-column))
-              (+ sexp-column lisp-body-indent)))
-       (error (+ sexp-column lisp-body-indent)))))
-
-
-(let ((l '((block 1)
-	   (catch 1)
-           (case        (4 &rest (&whole 2 &rest 1)))
-           (ccase . case) (ecase . case)
-           (typecase . case) (etypecase . case) (ctypecase . case)
-           (catch 1)
-           (cond        (&rest (&whole 2 &rest 1)))
-           (block 1)
-           (defvar      (4 2 2))
-           (defconstant . defvar) (defparameter . defvar)
-           (define-modify-macro
-                        (4 &body))
-           (define-setf-method
-                        (4 (&whole 4 &rest 1) &body))
-           (defsetf     (4 (&whole 4 &rest 1) 4 &body))
-           (defun       (4 (&whole 4 &rest 1) &body))
-           (defmacro . defun) (deftype . defun)
-           (defstruct   ((&whole 4 &rest (&whole 2 &rest 1))
-                         &rest (&whole 2 &rest 1)))
-           (destructuring-bind
-                        ((&whole 6 &rest 1) 4 &body))
-           (do          lisp-indent-do)
-           (do* . do)
-           (dolist      ((&whole 4 2 1) &body))
-           (dotimes . dolist)
-           (eval-when	1)
-           (flet        ((&whole 4 &rest (&whole 1 (&whole 4 &rest 1) &body))
-                         &body))
-           (labels . flet)
-           (macrolet . flet)
-           ;; `else-body' style
-           (if          (nil nil &body))
-           ;; single-else style (then and else equally indented)
-           (if          (&rest nil))
-           ;(lambda     ((&whole 4 &rest 1) &body))
-           (lambda      ((&whole 4 &rest 1)
-                         &rest lisp-indent-function-lambda-hack))
-           (let         ((&whole 4 &rest (&whole 1 1 2)) &body))
-           (let* . let)
-           (compiler-let . let) ;barf
-           (locally	1)
-           ;(loop ...)
-           (multiple-value-bind
-                        ((&whole 6 &rest 1) 4 &body))
-           (multiple-value-call
-			(4 &body))
-           (multiple-value-list 1)
-           (multiple-value-prog1 1)
-           (multiple-value-setq
-			(4 2))
-           ;; Combines the worst features of BLOCK, LET and TAGBODY
-           (prog        ((&whole 4 &rest 1) &rest lisp-indent-tagbody))
-           (prog* . prog)
-           (prog1 1)
-           (prog2 2)
-           (progn 0)
-           (progv       (4 4 &body))
-           (return 0)
-           (return-from (nil &body))
-           (tagbody     lisp-indent-tagbody)
-           (throw 1)
-           (unless 1)
-           (unwind-protect
-                        (5 &body))
-           (when 1))))
-  (while l
-    (put (car (car l)) 'common-lisp-indent-function
-         (if (symbolp (cdr (car l)))
-             (get (cdr (car l)) 'common-lisp-indent-function)
-             (car (cdr (car l)))))
-    (setq l (cdr l))))
-
-
-;(defun foo (x)
-;  (tagbody
-;   foo
-;     (bar)
-;   baz
-;     (when (losing)
-;       (with-big-loser
-;           (yow)
-;         ((lambda ()
-;            foo)
-;          big)))
-;     (flet ((foo (bar baz zap)
-;              (zip))
-;            (zot ()
-;              quux))
-;       (do ()
-;           ((lose)
-;            (foo 1))
-;         (quux)
-;        foo
-;         (lose))
-;       (cond ((x)
-;              (win 1 2
-;                   (foo)))
-;             (t
-;              (lose
-;                3))))))
-          
-
-;(put 'while    'common-lisp-indent-function 1)
-;(put 'defwrapper'common-lisp-indent-function ...)
-;(put 'def 'common-lisp-indent-function ...)
-;(put 'defflavor        'common-lisp-indent-function ...)
-;(put 'defsubst 'common-lisp-indent-function ...)
-
-;(put 'with-restart 'common-lisp-indent-function '((1 4 ((* 1))) (2 &body)))
-;(put 'restart-case 'common-lisp-indent-function '((1 4) (* 2 ((0 1) (* 1)))))
-;(put 'define-condition 'common-lisp-indent-function '((1 6) (2 6 ((* 1))) (3 4 ((* 1))) (4 &body)))
-;(put 'with-condition-handler 'common-lisp-indent-function '((1 4 ((* 1))) (2 &body)))
-;(put 'condition-case 'common-lisp-indent-function '((1 4) (* 2 ((0 1) (1 3) (2 &body)))))
-
-;;; cl-indent.el ends here
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
deleted file mode 100644
index 37d02b564cb..00000000000
--- a/lisp/emacs-lisp/cl-macs.el
+++ /dev/null
@@ -1,2635 +0,0 @@
-;;; cl-macs.el --- Common Lisp macros -*-byte-compile-dynamic: t;-*-
-
-;; Copyright (C) 1993 Free Software Foundation, Inc.
-
-;; Author: Dave Gillespie <daveg@synaptics.com>
-;; Version: 2.02
-;; Keywords: extensions
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; These are extensions to Emacs Lisp that provide a degree of
-;; Common Lisp compatibility, beyond what is already built-in
-;; in Emacs Lisp.
-;;
-;; This package was written by Dave Gillespie; it is a complete
-;; rewrite of Cesar Quiroz's original cl.el package of December 1986.
-;;
-;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19.
-;;
-;; Bug reports, comments, and suggestions are welcome!
-
-;; This file contains the portions of the Common Lisp extensions
-;; package which should be autoloaded, but need only be present
-;; if the compiler or interpreter is used---this file is not
-;; necessary for executing compiled code.
-
-;; See cl.el for Change Log.
-
-
-;;; Code:
-
-(or (memq 'cl-19 features)
-    (error "Tried to load `cl-macs' before `cl'!"))
-
-
-;;; We define these here so that this file can compile without having
-;;; loaded the cl.el file already.
-
-(defmacro cl-push (x place) (list 'setq place (list 'cons x place)))
-(defmacro cl-pop (place)
-  (list 'car (list 'prog1 place (list 'setq place (list 'cdr place)))))
-(defmacro cl-pop2 (place)
-  (list 'prog1 (list 'car (list 'cdr place))
-	(list 'setq place (list 'cdr (list 'cdr place)))))
-(put 'cl-push 'edebug-form-spec 'edebug-sexps)
-(put 'cl-pop 'edebug-form-spec 'edebug-sexps)
-(put 'cl-pop2 'edebug-form-spec 'edebug-sexps)
-
-(defvar cl-emacs-type)
-(defvar cl-optimize-safety)
-(defvar cl-optimize-speed)
-
-
-;;; This kludge allows macros which use cl-transform-function-property
-;;; to be called at compile-time.
-
-(require
- (progn
-   (or (fboundp 'defalias) (fset 'defalias 'fset))
-   (or (fboundp 'cl-transform-function-property)
-       (defalias 'cl-transform-function-property
-	 (function (lambda (n p f)
-		     (list 'put (list 'quote n) (list 'quote p)
-			   (list 'function (cons 'lambda f)))))))
-   (car (or features (setq features (list 'cl-kludge))))))
-
-
-;;; Initialization.
-
-(defvar cl-old-bc-file-form nil)
-
-;; Patch broken Emacs 18 compiler (re top-level macros).
-;; Emacs 19 compiler doesn't need this patch.
-;; Also, undo broken definition of `eql' that uses same bytecode as `eq'.
-(defun cl-compile-time-init ()
-  (setq cl-old-bc-file-form (symbol-function 'byte-compile-file-form))
-  (or (fboundp 'byte-compile-flush-pending)   ; Emacs 19 compiler?
-      (defalias 'byte-compile-file-form
-	(function
-	 (lambda (form)
-	   (setq form (macroexpand form byte-compile-macro-environment))
-	   (if (eq (car-safe form) 'progn)
-	       (cons 'progn (mapcar 'byte-compile-file-form (cdr form)))
-	     (funcall cl-old-bc-file-form form))))))
-  (put 'eql 'byte-compile 'cl-byte-compile-compiler-macro)
-  (run-hooks 'cl-hack-bytecomp-hook))
-
-
-;;; Symbols.
-
-(defvar *gensym-counter*)
-(defun gensym (&optional arg)
-  "Generate a new uninterned symbol.
-The name is made by appending a number to PREFIX, default \"G\"."
-  (let ((prefix (if (stringp arg) arg "G"))
-	(num (if (integerp arg) arg
-	       (prog1 *gensym-counter*
-		 (setq *gensym-counter* (1+ *gensym-counter*))))))
-    (make-symbol (format "%s%d" prefix num))))
-
-(defun gentemp (&optional arg)
-  "Generate a new interned symbol with a unique name.
-The name is made by appending a number to PREFIX, default \"G\"."
-  (let ((prefix (if (stringp arg) arg "G"))
-	name)
-    (while (intern-soft (setq name (format "%s%d" prefix *gensym-counter*)))
-      (setq *gensym-counter* (1+ *gensym-counter*)))
-    (intern name)))
-
-
-;;; Program structure.
-
-(defmacro defun* (name args &rest body)
-  "(defun* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function.
-Like normal `defun', except ARGLIST allows full Common Lisp conventions,
-and BODY is implicitly surrounded by (block NAME ...)."
-  (let* ((res (cl-transform-lambda (cons args body) name))
-	 (form (list* 'defun name (cdr res))))
-    (if (car res) (list 'progn (car res) form) form)))
-
-(defmacro defmacro* (name args &rest body)
-  "(defmacro* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a macro.
-Like normal `defmacro', except ARGLIST allows full Common Lisp conventions,
-and BODY is implicitly surrounded by (block NAME ...)."
-  (let* ((res (cl-transform-lambda (cons args body) name))
-	 (form (list* 'defmacro name (cdr res))))
-    (if (car res) (list 'progn (car res) form) form)))
-
-(defmacro function* (func)
-  "(function* SYMBOL-OR-LAMBDA): introduce a function.
-Like normal `function', except that if argument is a lambda form, its
-ARGLIST allows full Common Lisp conventions."
-  (if (eq (car-safe func) 'lambda)
-      (let* ((res (cl-transform-lambda (cdr func) 'cl-none))
-	     (form (list 'function (cons 'lambda (cdr res)))))
-	(if (car res) (list 'progn (car res) form) form))
-    (list 'function func)))
-
-(defun cl-transform-function-property (func prop form)
-  (let ((res (cl-transform-lambda form func)))
-    (append '(progn) (cdr (cdr (car res)))
-	    (list (list 'put (list 'quote func) (list 'quote prop)
-			(list 'function (cons 'lambda (cdr res))))))))
-
-(defconst lambda-list-keywords
-  '(&optional &rest &key &allow-other-keys &aux &whole &body &environment))
-
-(defvar cl-macro-environment nil)
-(defvar bind-block) (defvar bind-defs) (defvar bind-enquote)
-(defvar bind-inits) (defvar bind-lets) (defvar bind-forms)
-
-(defun cl-transform-lambda (form bind-block)
-  (let* ((args (car form)) (body (cdr form))
-	 (bind-defs nil) (bind-enquote nil)
-	 (bind-inits nil) (bind-lets nil) (bind-forms nil)
-	 (header nil) (simple-args nil))
-    (while (or (stringp (car body)) (eq (car-safe (car body)) 'interactive))
-      (cl-push (cl-pop body) header))
-    (setq args (if (listp args) (copy-list args) (list '&rest args)))
-    (let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p)))))
-    (if (setq bind-defs (cadr (memq '&cl-defs args)))
-	(setq args (delq '&cl-defs (delq bind-defs args))
-	      bind-defs (cadr bind-defs)))
-    (if (setq bind-enquote (memq '&cl-quote args))
-	(setq args (delq '&cl-quote args)))
-    (if (memq '&whole args) (error "&whole not currently implemented"))
-    (let* ((p (memq '&environment args)) (v (cadr p)))
-      (if p (setq args (nconc (delq (car p) (delq v args))
-			      (list '&aux (list v 'cl-macro-environment))))))
-    (while (and args (symbolp (car args))
-		(not (memq (car args) '(nil &rest &body &key &aux)))
-		(not (and (eq (car args) '&optional)
-			  (or bind-defs (consp (cadr args))))))
-      (cl-push (cl-pop args) simple-args))
-    (or (eq bind-block 'cl-none)
-	(setq body (list (list* 'block bind-block body))))
-    (if (null args)
-	(list* nil (nreverse simple-args) (nconc (nreverse header) body))
-      (if (memq '&optional simple-args) (cl-push '&optional args))
-      (cl-do-arglist args nil (- (length simple-args)
-				 (if (memq '&optional simple-args) 1 0)))
-      (setq bind-lets (nreverse bind-lets))
-      (list* (and bind-inits (list* 'eval-when '(compile load eval)
-				    (nreverse bind-inits)))
-	     (nconc (nreverse simple-args)
-		    (list '&rest (car (cl-pop bind-lets))))
-	     (nconc (nreverse header)
-		    (list (nconc (list 'let* bind-lets)
-				 (nreverse bind-forms) body)))))))
-
-(defun cl-do-arglist (args expr &optional num)   ; uses bind-*
-  (if (nlistp args)
-      (if (or (memq args lambda-list-keywords) (not (symbolp args)))
-	  (error "Invalid argument name: %s" args)
-	(cl-push (list args expr) bind-lets))
-    (setq args (copy-list args))
-    (let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p)))))
-    (let ((p (memq '&body args))) (if p (setcar p '&rest)))
-    (if (memq '&environment args) (error "&environment used incorrectly"))
-    (let ((save-args args)
-	  (restarg (memq '&rest args))
-	  (safety (if (cl-compiling-file) cl-optimize-safety 3))
-	  (keys nil)
-	  (laterarg nil) (exactarg nil) minarg)
-      (or num (setq num 0))
-      (if (listp (cadr restarg))
-	  (setq restarg (gensym "--rest--"))
-	(setq restarg (cadr restarg)))
-      (cl-push (list restarg expr) bind-lets)
-      (if (eq (car args) '&whole)
-	  (cl-push (list (cl-pop2 args) restarg) bind-lets))
-      (let ((p args))
-	(setq minarg restarg)
-	(while (and p (not (memq (car p) lambda-list-keywords)))
-	  (or (eq p args) (setq minarg (list 'cdr minarg)))
-	  (setq p (cdr p)))
-	(if (memq (car p) '(nil &aux))
-	    (setq minarg (list '= (list 'length restarg)
-			       (length (ldiff args p)))
-		  exactarg (not (eq args p)))))
-      (while (and args (not (memq (car args) lambda-list-keywords)))
-	(let ((poparg (list (if (or (cdr args) (not exactarg)) 'pop 'car)
-			    restarg)))
-	  (cl-do-arglist
-	   (cl-pop args)
-	   (if (or laterarg (= safety 0)) poparg
-	     (list 'if minarg poparg
-		   (list 'signal '(quote wrong-number-of-arguments)
-			 (list 'list (and (not (eq bind-block 'cl-none))
-					  (list 'quote bind-block))
-			       (list 'length restarg)))))))
-	(setq num (1+ num) laterarg t))
-      (while (and (eq (car args) '&optional) (cl-pop args))
-	(while (and args (not (memq (car args) lambda-list-keywords)))
-	  (let ((arg (cl-pop args)))
-	    (or (consp arg) (setq arg (list arg)))
-	    (if (cddr arg) (cl-do-arglist (nth 2 arg) (list 'and restarg t)))
-	    (let ((def (if (cdr arg) (nth 1 arg)
-			 (or (car bind-defs)
-			     (nth 1 (assq (car arg) bind-defs)))))
-		  (poparg (list 'pop restarg)))
-	      (and def bind-enquote (setq def (list 'quote def)))
-	      (cl-do-arglist (car arg)
-			     (if def (list 'if restarg poparg def) poparg))
-	      (setq num (1+ num))))))
-      (if (eq (car args) '&rest)
-	  (let ((arg (cl-pop2 args)))
-	    (if (consp arg) (cl-do-arglist arg restarg)))
-	(or (eq (car args) '&key) (= safety 0) exactarg
-	    (cl-push (list 'if restarg
-			   (list 'signal '(quote wrong-number-of-arguments)
-				 (list 'list
-				       (and (not (eq bind-block 'cl-none))
-					    (list 'quote bind-block))
-				       (list '+ num (list 'length restarg)))))
-		     bind-forms)))
-      (while (and (eq (car args) '&key) (cl-pop args))
-	(while (and args (not (memq (car args) lambda-list-keywords)))
-	  (let ((arg (cl-pop args)))
-	    (or (consp arg) (setq arg (list arg)))
-	    (let* ((karg (if (consp (car arg)) (caar arg)
-			   (intern (format ":%s" (car arg)))))
-		   (varg (if (consp (car arg)) (cadar arg) (car arg)))
-		   (def (if (cdr arg) (cadr arg)
-			  (or (car bind-defs) (cadr (assq varg bind-defs)))))
-		   (look (list 'memq (list 'quote karg) restarg)))
-	      (and def bind-enquote (setq def (list 'quote def)))
-	      (if (cddr arg)
-		  (let* ((temp (or (nth 2 arg) (gensym)))
-			 (val (list 'car (list 'cdr temp))))
-		    (cl-do-arglist temp look)
-		    (cl-do-arglist varg
-				   (list 'if temp
-					 (list 'prog1 val (list 'setq temp t))
-					 def)))
-		(cl-do-arglist
-		 varg
-		 (list 'car
-		       (list 'cdr
-			     (if (null def)
-				 look
-			       (list 'or look
-				     (if (eq (cl-const-expr-p def) t)
-					 (list
-					  'quote
-					  (list nil (cl-const-expr-val def)))
-				       (list 'list nil def))))))))
-	      (cl-push karg keys)
-	      (if (= (aref (symbol-name karg) 0) ?:)
-		  (progn (set karg karg)
-			 (cl-push (list 'setq karg (list 'quote karg))
-				  bind-inits)))))))
-      (setq keys (nreverse keys))
-      (or (and (eq (car args) '&allow-other-keys) (cl-pop args))
-	  (null keys) (= safety 0)
-	  (let* ((var (gensym "--keys--"))
-		 (allow '(:allow-other-keys))
-		 (check (list
-			 'while var
-			 (list
-			  'cond
-			  (list (list 'memq (list 'car var)
-				      (list 'quote (append keys allow)))
-				(list 'setq var (list 'cdr (list 'cdr var))))
-			  (list (list 'car
-				      (list 'cdr
-					    (list 'memq (cons 'quote allow)
-						  restarg)))
-				(list 'setq var nil))
-			  (list t
-				(list
-				 'error
-				 (format "Keyword argument %%s not one of %s"
-					 keys)
-				 (list 'car var)))))))
-	    (cl-push (list 'let (list (list var restarg)) check) bind-forms)))
-      (while (and (eq (car args) '&aux) (cl-pop args))
-	(while (and args (not (memq (car args) lambda-list-keywords)))
-	  (if (consp (car args))
-	      (if (and bind-enquote (cadar args))
-		  (cl-do-arglist (caar args)
-				 (list 'quote (cadr (cl-pop args))))
-		(cl-do-arglist (caar args) (cadr (cl-pop args))))
-	    (cl-do-arglist (cl-pop args) nil))))
-      (if args (error "Malformed argument list %s" save-args)))))
-
-(defun cl-arglist-args (args)
-  (if (nlistp args) (list args)
-    (let ((res nil) (kind nil) arg)
-      (while (consp args)
-	(setq arg (cl-pop args))
-	(if (memq arg lambda-list-keywords) (setq kind arg)
-	  (if (eq arg '&cl-defs) (cl-pop args)
-	    (and (consp arg) kind (setq arg (car arg)))
-	    (and (consp arg) (cdr arg) (eq kind '&key) (setq arg (cadr arg)))
-	    (setq res (nconc res (cl-arglist-args arg))))))
-      (nconc res (and args (list args))))))
-
-(defmacro destructuring-bind (args expr &rest body)
-  (let* ((bind-lets nil) (bind-forms nil) (bind-inits nil)
-	 (bind-defs nil) (bind-block 'cl-none))
-    (cl-do-arglist (or args '(&aux)) expr)
-    (append '(progn) bind-inits
-	    (list (nconc (list 'let* (nreverse bind-lets))
-			 (nreverse bind-forms) body)))))
-
-
-;;; The `eval-when' form.
-
-(defvar cl-not-toplevel nil)
-
-(defmacro eval-when (when &rest body)
-  "(eval-when (WHEN...) BODY...): control when BODY is evaluated.
-If `compile' is in WHEN, BODY is evaluated when compiled at top-level.
-If `load' is in WHEN, BODY is evaluated when loaded after top-level compile.
-If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level."
-  (if (and (fboundp 'cl-compiling-file) (cl-compiling-file)
-	   (not cl-not-toplevel) (not (boundp 'for-effect)))  ; horrible kludge
-      (let ((comp (or (memq 'compile when) (memq ':compile-toplevel when)))
-	    (cl-not-toplevel t))
-	(if (or (memq 'load when) (memq ':load-toplevel when))
-	    (if comp (cons 'progn (mapcar 'cl-compile-time-too body))
-	      (list* 'if nil nil body))
-	  (progn (if comp (eval (cons 'progn body))) nil)))
-    (and (or (memq 'eval when) (memq ':execute when))
-	 (cons 'progn body))))
-
-(defun cl-compile-time-too (form)
-  (or (and (symbolp (car-safe form)) (get (car-safe form) 'byte-hunk-handler))
-      (setq form (macroexpand
-		  form (cons '(eval-when) byte-compile-macro-environment))))
-  (cond ((eq (car-safe form) 'progn)
-	 (cons 'progn (mapcar 'cl-compile-time-too (cdr form))))
-	((eq (car-safe form) 'eval-when)
-	 (let ((when (nth 1 form)))
-	   (if (or (memq 'eval when) (memq ':execute when))
-	       (list* 'eval-when (cons 'compile when) (cddr form))
-	     form)))
-	(t (eval form) form)))
-
-(or (and (fboundp 'eval-when-compile)
-	 (not (eq (car-safe (symbol-function 'eval-when-compile)) 'autoload)))
-    (eval '(defmacro eval-when-compile (&rest body)
-	     "Like `progn', but evaluates the body at compile time.
-The result of the body appears to the compiler as a quoted constant."
-	     (list 'quote (eval (cons 'progn body))))))
-
-(defmacro load-time-value (form &optional read-only)
-  "Like `progn', but evaluates the body at load time.
-The result of the body appears to the compiler as a quoted constant."
-  (if (cl-compiling-file)
-      (let* ((temp (gentemp "--cl-load-time--"))
-	     (set (list 'set (list 'quote temp) form)))
-	(if (and (fboundp 'byte-compile-file-form-defmumble)
-		 (boundp 'this-kind) (boundp 'that-one))
-	    (fset 'byte-compile-file-form
-		  (list 'lambda '(form)
-			(list 'fset '(quote byte-compile-file-form)
-			      (list 'quote
-				    (symbol-function 'byte-compile-file-form)))
-			(list 'byte-compile-file-form (list 'quote set))
-			'(byte-compile-file-form form)))
-	  (print set (symbol-value 'outbuffer)))
-	(list 'symbol-value (list 'quote temp)))
-    (list 'quote (eval form))))
-
-
-;;; Conditional control structures.
-
-(defmacro case (expr &rest clauses)
-  "(case EXPR CLAUSES...): evals EXPR, chooses from CLAUSES on that value.
-Each clause looks like (KEYLIST BODY...).  EXPR is evaluated and compared
-against each key in each KEYLIST; the corresponding BODY is evaluated.
-If no clause succeeds, case returns nil.  A single atom may be used in
-place of a KEYLIST of one atom.  A KEYLIST of `t' or `otherwise' is
-allowed only in the final clause, and matches if no other keys match.
-Key values are compared by `eql'."
-  (let* ((temp (if (cl-simple-expr-p expr 3) expr (gensym)))
-	 (head-list nil)
-	 (body (cons
-		'cond
-		(mapcar
-		 (function
-		  (lambda (c)
-		    (cons (cond ((memq (car c) '(t otherwise)) t)
-				((eq (car c) 'ecase-error-flag)
-				 (list 'error "ecase failed: %s, %s"
-				       temp (list 'quote (reverse head-list))))
-				((listp (car c))
-				 (setq head-list (append (car c) head-list))
-				 (list 'member* temp (list 'quote (car c))))
-				(t
-				 (if (memq (car c) head-list)
-				     (error "Duplicate key in case: %s"
-					    (car c)))
-				 (cl-push (car c) head-list)
-				 (list 'eql temp (list 'quote (car c)))))
-			  (or (cdr c) '(nil)))))
-		 clauses))))
-    (if (eq temp expr) body
-      (list 'let (list (list temp expr)) body))))
-
-(defmacro ecase (expr &rest clauses)
-  "(ecase EXPR CLAUSES...): like `case', but error if no case fits.
-`otherwise'-clauses are not allowed."
-  (list* 'case expr (append clauses '((ecase-error-flag)))))
-
-(defmacro typecase (expr &rest clauses)
-  "(typecase EXPR CLAUSES...): evals EXPR, chooses from CLAUSES on that value.
-Each clause looks like (TYPE BODY...).  EXPR is evaluated and, if it
-satisfies TYPE, the corresponding BODY is evaluated.  If no clause succeeds,
-typecase returns nil.  A TYPE of `t' or `otherwise' is allowed only in the
-final clause, and matches if no other keys match."
-  (let* ((temp (if (cl-simple-expr-p expr 3) expr (gensym)))
-	 (type-list nil)
-	 (body (cons
-		'cond
-		(mapcar
-		 (function
-		  (lambda (c)
-		    (cons (cond ((eq (car c) 'otherwise) t)
-				((eq (car c) 'ecase-error-flag)
-				 (list 'error "etypecase failed: %s, %s"
-				       temp (list 'quote (reverse type-list))))
-				(t
-				 (cl-push (car c) type-list)
-				 (cl-make-type-test temp (car c))))
-			  (or (cdr c) '(nil)))))
-		 clauses))))
-    (if (eq temp expr) body
-      (list 'let (list (list temp expr)) body))))
-
-(defmacro etypecase (expr &rest clauses)
-  "(etypecase EXPR CLAUSES...): like `typecase', but error if no case fits.
-`otherwise'-clauses are not allowed."
-  (list* 'typecase expr (append clauses '((ecase-error-flag)))))
-
-
-;;; Blocks and exits.
-
-(defmacro block (name &rest body)
-  "(block NAME BODY...): define a lexically-scoped block named NAME.
-NAME may be any symbol.  Code inside the BODY forms can call `return-from'
-to jump prematurely out of the block.  This differs from `catch' and `throw'
-in two respects:  First, the NAME is an unevaluated symbol rather than a
-quoted symbol or other form; and second, NAME is lexically rather than
-dynamically scoped:  Only references to it within BODY will work.  These
-references may appear inside macro expansions, but not inside functions
-called from BODY."
-  (if (cl-safe-expr-p (cons 'progn body)) (cons 'progn body)
-    (list 'cl-block-wrapper
-	  (list* 'catch (list 'quote (intern (format "--cl-block-%s--" name)))
-		 body))))
-
-(defvar cl-active-block-names nil)
-
-(put 'cl-block-wrapper 'byte-compile 'cl-byte-compile-block)
-(defun cl-byte-compile-block (cl-form)
-  (if (fboundp 'byte-compile-form-do-effect)  ; Check for optimizing compiler
-      (progn
-	(let* ((cl-entry (cons (nth 1 (nth 1 (nth 1 cl-form))) nil))
-	       (cl-active-block-names (cons cl-entry cl-active-block-names))
-	       (cl-body (byte-compile-top-level
-			 (cons 'progn (cddr (nth 1 cl-form))))))
-	  (if (cdr cl-entry)
-	      (byte-compile-form (list 'catch (nth 1 (nth 1 cl-form)) cl-body))
-	    (byte-compile-form cl-body))))
-    (byte-compile-form (nth 1 cl-form))))
-
-(put 'cl-block-throw 'byte-compile 'cl-byte-compile-throw)
-(defun cl-byte-compile-throw (cl-form)
-  (let ((cl-found (assq (nth 1 (nth 1 cl-form)) cl-active-block-names)))
-    (if cl-found (setcdr cl-found t)))
-  (byte-compile-normal-call (cons 'throw (cdr cl-form))))
-
-(defmacro return (&optional res)
-  "(return [RESULT]): return from the block named nil.
-This is equivalent to `(return-from nil RESULT)'."
-  (list 'return-from nil res))
-
-(defmacro return-from (name &optional res)
-  "(return-from NAME [RESULT]): return from the block named NAME.
-This jump out to the innermost enclosing `(block NAME ...)' form,
-returning RESULT from that form (or nil if RESULT is omitted).
-This is compatible with Common Lisp, but note that `defun' and
-`defmacro' do not create implicit blocks as they do in Common Lisp."
-  (let ((name2 (intern (format "--cl-block-%s--" name))))
-    (list 'cl-block-throw (list 'quote name2) res)))
-
-
-;;; The "loop" macro.
-
-(defvar args) (defvar loop-accum-var) (defvar loop-accum-vars)
-(defvar loop-bindings) (defvar loop-body) (defvar loop-destr-temps)
-(defvar loop-finally) (defvar loop-finish-flag) (defvar loop-first-flag)
-(defvar loop-initially) (defvar loop-map-form) (defvar loop-name)
-(defvar loop-result) (defvar loop-result-explicit)
-(defvar loop-result-var) (defvar loop-steps) (defvar loop-symbol-macs)
-
-(defmacro loop (&rest args)
-  "(loop CLAUSE...): The Common Lisp `loop' macro.
-Valid clauses are:
-  for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM,
-  for VAR in LIST by FUNC, for VAR on LIST by FUNC, for VAR = INIT then EXPR,
-  for VAR across ARRAY, repeat NUM, with VAR = INIT, while COND, until COND,
-  always COND, never COND, thereis COND, collect EXPR into VAR,
-  append EXPR into VAR, nconc EXPR into VAR, sum EXPR into VAR,
-  count EXPR into VAR, maximize EXPR into VAR, minimize EXPR into VAR,
-  if COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...],
-  unless COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...],
-  do EXPRS..., initially EXPRS..., finally EXPRS..., return EXPR,
-  finally return EXPR, named NAME."
-  (if (not (memq t (mapcar 'symbolp (delq nil (delq t (copy-list args))))))
-      (list 'block nil (list* 'while t args))
-    (let ((loop-name nil)	(loop-bindings nil)
-	  (loop-body nil)	(loop-steps nil)
-	  (loop-result nil)	(loop-result-explicit nil)
-	  (loop-result-var nil) (loop-finish-flag nil)
-	  (loop-accum-var nil)	(loop-accum-vars nil)
-	  (loop-initially nil)	(loop-finally nil)
-	  (loop-map-form nil)   (loop-first-flag nil)
-	  (loop-destr-temps nil) (loop-symbol-macs nil))
-      (setq args (append args '(cl-end-loop)))
-      (while (not (eq (car args) 'cl-end-loop)) (cl-parse-loop-clause))
-      (if loop-finish-flag
-	  (cl-push (list (list loop-finish-flag t)) loop-bindings))
-      (if loop-first-flag
-	  (progn (cl-push (list (list loop-first-flag t)) loop-bindings)
-		 (cl-push (list 'setq loop-first-flag nil) loop-steps)))
-      (let* ((epilogue (nconc (nreverse loop-finally)
-			      (list (or loop-result-explicit loop-result))))
-	     (ands (cl-loop-build-ands (nreverse loop-body)))
-	     (while-body (nconc (cadr ands) (nreverse loop-steps)))
-	     (body (append
-		    (nreverse loop-initially)
-		    (list (if loop-map-form
-			      (list 'block '--cl-finish--
-				    (subst
-				     (if (eq (car ands) t) while-body
-				       (cons (list 'or (car ands)
-						   '(return-from --cl-finish--
-						      nil))
-					     while-body))
-				     '--cl-map loop-map-form))
-			    (list* 'while (car ands) while-body)))
-		    (if loop-finish-flag
-			(if (equal epilogue '(nil)) (list loop-result-var)
-			  (list (list 'if loop-finish-flag
-				      (cons 'progn epilogue) loop-result-var)))
-		      epilogue))))
-	(if loop-result-var (cl-push (list loop-result-var) loop-bindings))
-	(while loop-bindings
-	  (if (cdar loop-bindings)
-	      (setq body (list (cl-loop-let (cl-pop loop-bindings) body t)))
-	    (let ((lets nil))
-	      (while (and loop-bindings
-			  (not (cdar loop-bindings)))
-		(cl-push (car (cl-pop loop-bindings)) lets))
-	      (setq body (list (cl-loop-let lets body nil))))))
-	(if loop-symbol-macs
-	    (setq body (list (list* 'symbol-macrolet loop-symbol-macs body))))
-	(list* 'block loop-name body)))))
-
-(defun cl-parse-loop-clause ()   ; uses args, loop-*
-  (let ((word (cl-pop args))
-	(hash-types '(hash-key hash-keys hash-value hash-values))
-	(key-types '(key-code key-codes key-seq key-seqs
-		     key-binding key-bindings)))
-    (cond
-
-     ((null args)
-      (error "Malformed `loop' macro"))
-
-     ((eq word 'named)
-      (setq loop-name (cl-pop args)))
-
-     ((eq word 'initially)
-      (if (memq (car args) '(do doing)) (cl-pop args))
-      (or (consp (car args)) (error "Syntax error on `initially' clause"))
-      (while (consp (car args))
-	(cl-push (cl-pop args) loop-initially)))
-
-     ((eq word 'finally)
-      (if (eq (car args) 'return)
-	  (setq loop-result-explicit (or (cl-pop2 args) '(quote nil)))
-	(if (memq (car args) '(do doing)) (cl-pop args))
-	(or (consp (car args)) (error "Syntax error on `finally' clause"))
-	(if (and (eq (caar args) 'return) (null loop-name))
-	    (setq loop-result-explicit (or (nth 1 (cl-pop args)) '(quote nil)))
-	  (while (consp (car args))
-	    (cl-push (cl-pop args) loop-finally)))))
-
-     ((memq word '(for as))
-      (let ((loop-for-bindings nil) (loop-for-sets nil) (loop-for-steps nil)
-	    (ands nil))
-	(while
-	    (let ((var (or (cl-pop args) (gensym))))
-	      (setq word (cl-pop args))
-	      (if (eq word 'being) (setq word (cl-pop args)))
-	      (if (memq word '(the each)) (setq word (cl-pop args)))
-	      (if (memq word '(buffer buffers))
-		  (setq word 'in args (cons '(buffer-list) args)))
-	      (cond
-
-	       ((memq word '(from downfrom upfrom to downto upto
-			     above below by))
-		(cl-push word args)
-		(if (memq (car args) '(downto above))
-		    (error "Must specify `from' value for downward loop"))
-		(let* ((down (or (eq (car args) 'downfrom)
-				 (memq (caddr args) '(downto above))))
-		       (excl (or (memq (car args) '(above below))
-				 (memq (caddr args) '(above below))))
-		       (start (and (memq (car args) '(from upfrom downfrom))
-				   (cl-pop2 args)))
-		       (end (and (memq (car args)
-				       '(to upto downto above below))
-				 (cl-pop2 args)))
-		       (step (and (eq (car args) 'by) (cl-pop2 args)))
-		       (end-var (and (not (cl-const-expr-p end)) (gensym)))
-		       (step-var (and (not (cl-const-expr-p step))
-				      (gensym))))
-		  (and step (numberp step) (<= step 0)
-		       (error "Loop `by' value is not positive: %s" step))
-		  (cl-push (list var (or start 0)) loop-for-bindings)
-		  (if end-var (cl-push (list end-var end) loop-for-bindings))
-		  (if step-var (cl-push (list step-var step)
-					loop-for-bindings))
-		  (if end
-		      (cl-push (list
-				(if down (if excl '> '>=) (if excl '< '<=))
-				var (or end-var end)) loop-body))
-		  (cl-push (list var (list (if down '- '+) var
-					   (or step-var step 1)))
-			   loop-for-steps)))
-
-	       ((memq word '(in in-ref on))
-		(let* ((on (eq word 'on))
-		       (temp (if (and on (symbolp var)) var (gensym))))
-		  (cl-push (list temp (cl-pop args)) loop-for-bindings)
-		  (cl-push (list 'consp temp) loop-body)
-		  (if (eq word 'in-ref)
-		      (cl-push (list var (list 'car temp)) loop-symbol-macs)
-		    (or (eq temp var)
-			(progn
-			  (cl-push (list var nil) loop-for-bindings)
-			  (cl-push (list var (if on temp (list 'car temp)))
-				   loop-for-sets))))
-		  (cl-push (list temp
-				 (if (eq (car args) 'by)
-				     (let ((step (cl-pop2 args)))
-				       (if (and (memq (car-safe step)
-						      '(quote function
-							      function*))
-						(symbolp (nth 1 step)))
-					   (list (nth 1 step) temp)
-					 (list 'funcall step temp)))
-				   (list 'cdr temp)))
-			   loop-for-steps)))
-
-	       ((eq word '=)
-		(let* ((start (cl-pop args))
-		       (then (if (eq (car args) 'then) (cl-pop2 args) start)))
-		  (cl-push (list var nil) loop-for-bindings)
-		  (if (or ands (eq (car args) 'and))
-		      (progn
-			(cl-push (list var
-				       (list 'if
-					     (or loop-first-flag
-						 (setq loop-first-flag
-						       (gensym)))
-					     start var))
-				 loop-for-sets)
-			(cl-push (list var then) loop-for-steps))
-		    (cl-push (list var
-				   (if (eq start then) start
-				     (list 'if
-					   (or loop-first-flag
-					       (setq loop-first-flag (gensym)))
-					   start then)))
-			     loop-for-sets))))
-
-	       ((memq word '(across across-ref))
-		(let ((temp-vec (gensym)) (temp-idx (gensym)))
-		  (cl-push (list temp-vec (cl-pop args)) loop-for-bindings)
-		  (cl-push (list temp-idx -1) loop-for-bindings)
-		  (cl-push (list '< (list 'setq temp-idx (list '1+ temp-idx))
-				 (list 'length temp-vec)) loop-body)
-		  (if (eq word 'across-ref)
-		      (cl-push (list var (list 'aref temp-vec temp-idx))
-			       loop-symbol-macs)
-		    (cl-push (list var nil) loop-for-bindings)
-		    (cl-push (list var (list 'aref temp-vec temp-idx))
-			     loop-for-sets))))
-
-	       ((memq word '(element elements))
-		(let ((ref (or (memq (car args) '(in-ref of-ref))
-			       (and (not (memq (car args) '(in of)))
-				    (error "Expected `of'"))))
-		      (seq (cl-pop2 args))
-		      (temp-seq (gensym))
-		      (temp-idx (if (eq (car args) 'using)
-				    (if (and (= (length (cadr args)) 2)
-					     (eq (caadr args) 'index))
-					(cadr (cl-pop2 args))
-				      (error "Bad `using' clause"))
-				  (gensym))))
-		  (cl-push (list temp-seq seq) loop-for-bindings)
-		  (cl-push (list temp-idx 0) loop-for-bindings)
-		  (if ref
-		      (let ((temp-len (gensym)))
-			(cl-push (list temp-len (list 'length temp-seq))
-				 loop-for-bindings)
-			(cl-push (list var (list 'elt temp-seq temp-idx))
-				 loop-symbol-macs)
-			(cl-push (list '< temp-idx temp-len) loop-body))
-		    (cl-push (list var nil) loop-for-bindings)
-		    (cl-push (list 'and temp-seq
-				   (list 'or (list 'consp temp-seq)
-					 (list '< temp-idx
-					       (list 'length temp-seq))))
-			     loop-body)
-		    (cl-push (list var (list 'if (list 'consp temp-seq)
-					     (list 'pop temp-seq)
-					     (list 'aref temp-seq temp-idx)))
-			     loop-for-sets))
-		  (cl-push (list temp-idx (list '1+ temp-idx))
-			   loop-for-steps)))
-
-	       ((memq word hash-types)
-		(or (memq (car args) '(in of)) (error "Expected `of'"))
-		(let* ((table (cl-pop2 args))
-		       (other (if (eq (car args) 'using)
-				  (if (and (= (length (cadr args)) 2)
-					   (memq (caadr args) hash-types)
-					   (not (eq (caadr args) word)))
-				      (cadr (cl-pop2 args))
-				    (error "Bad `using' clause"))
-				(gensym))))
-		  (if (memq word '(hash-value hash-values))
-		      (setq var (prog1 other (setq other var))))
-		  (setq loop-map-form
-			(list 'maphash (list 'function
-					     (list* 'lambda (list var other)
-						    '--cl-map)) table))))
-
-	       ((memq word '(symbol present-symbol external-symbol
-			     symbols present-symbols external-symbols))
-		(let ((ob (and (memq (car args) '(in of)) (cl-pop2 args))))
-		  (setq loop-map-form
-			(list 'mapatoms (list 'function
-					      (list* 'lambda (list var)
-						     '--cl-map)) ob))))
-
-	       ((memq word '(overlay overlays extent extents))
-		(let ((buf nil) (from nil) (to nil))
-		  (while (memq (car args) '(in of from to))
-		    (cond ((eq (car args) 'from) (setq from (cl-pop2 args)))
-			  ((eq (car args) 'to) (setq to (cl-pop2 args)))
-			  (t (setq buf (cl-pop2 args)))))
-		  (setq loop-map-form
-			(list 'cl-map-extents
-			      (list 'function (list 'lambda (list var (gensym))
-						    '(progn . --cl-map) nil))
-			      buf from to))))
-
-	       ((memq word '(interval intervals))
-		(let ((buf nil) (prop nil) (from nil) (to nil)
-		      (var1 (gensym)) (var2 (gensym)))
-		  (while (memq (car args) '(in of property from to))
-		    (cond ((eq (car args) 'from) (setq from (cl-pop2 args)))
-			  ((eq (car args) 'to) (setq to (cl-pop2 args)))
-			  ((eq (car args) 'property)
-			   (setq prop (cl-pop2 args)))
-			  (t (setq buf (cl-pop2 args)))))
-		  (if (and (consp var) (symbolp (car var)) (symbolp (cdr var)))
-		      (setq var1 (car var) var2 (cdr var))
-		    (cl-push (list var (list 'cons var1 var2)) loop-for-sets))
-		  (setq loop-map-form
-			(list 'cl-map-intervals
-			      (list 'function (list 'lambda (list var1 var2)
-						    '(progn . --cl-map)))
-			      buf prop from to))))
-
-	       ((memq word key-types)
-		(or (memq (car args) '(in of)) (error "Expected `of'"))
-		(let ((map (cl-pop2 args))
-		      (other (if (eq (car args) 'using)
-				 (if (and (= (length (cadr args)) 2)
-					  (memq (caadr args) key-types)
-					  (not (eq (caadr args) word)))
-				     (cadr (cl-pop2 args))
-				   (error "Bad `using' clause"))
-			       (gensym))))
-		  (if (memq word '(key-binding key-bindings))
-		      (setq var (prog1 other (setq other var))))
-		  (setq loop-map-form
-			(list (if (memq word '(key-seq key-seqs))
-				  'cl-map-keymap-recursively 'cl-map-keymap)
-			      (list 'function (list* 'lambda (list var other)
-						     '--cl-map)) map))))
-
-	       ((memq word '(frame frames screen screens))
-		(let ((temp (gensym)))
-		  (cl-push (list var (if (eq cl-emacs-type 'lucid)
-					 '(selected-screen) '(selected-frame)))
-			   loop-for-bindings)
-		  (cl-push (list temp nil) loop-for-bindings)
-		  (cl-push (list 'prog1 (list 'not (list 'eq var temp))
-				 (list 'or temp (list 'setq temp var)))
-			   loop-body)
-		  (cl-push (list var (list (if (eq cl-emacs-type 'lucid)
-					       'next-screen 'next-frame) var))
-			   loop-for-steps)))
-
-	       ((memq word '(window windows))
-		(let ((scr (and (memq (car args) '(in of)) (cl-pop2 args)))
-		      (temp (gensym)))
-		  (cl-push (list var (if scr
-					 (list (if (eq cl-emacs-type 'lucid)
-						   'screen-selected-window
-						 'frame-selected-window) scr)
-				       '(selected-window)))
-			   loop-for-bindings)
-		  (cl-push (list temp nil) loop-for-bindings)
-		  (cl-push (list 'prog1 (list 'not (list 'eq var temp))
-				 (list 'or temp (list 'setq temp var)))
-			   loop-body)
-		  (cl-push (list var (list 'next-window var)) loop-for-steps)))
-
-	       (t
-		(let ((handler (and (symbolp word)
-				    (get word 'cl-loop-for-handler))))
-		  (if handler
-		      (funcall handler var)
-		    (error "Expected a `for' preposition, found %s" word)))))
-	      (eq (car args) 'and))
-	  (setq ands t)
-	  (cl-pop args))
-	(if (and ands loop-for-bindings)
-	    (cl-push (nreverse loop-for-bindings) loop-bindings)
-	  (setq loop-bindings (nconc (mapcar 'list loop-for-bindings)
-				     loop-bindings)))
-	(if loop-for-sets
-	    (cl-push (list 'progn
-			   (cl-loop-let (nreverse loop-for-sets) 'setq ands)
-			   t) loop-body))
-	(if loop-for-steps
-	    (cl-push (cons (if ands 'psetq 'setq)
-			   (apply 'append (nreverse loop-for-steps)))
-		     loop-steps))))
-
-     ((eq word 'repeat)
-      (let ((temp (gensym)))
-	(cl-push (list (list temp (cl-pop args))) loop-bindings)
-	(cl-push (list '>= (list 'setq temp (list '1- temp)) 0) loop-body)))
-
-     ((eq word 'collect)
-      (let ((what (cl-pop args))
-	    (var (cl-loop-handle-accum nil 'nreverse)))
-	(if (eq var loop-accum-var)
-	    (cl-push (list 'progn (list 'push what var) t) loop-body)
-	  (cl-push (list 'progn
-			 (list 'setq var (list 'nconc var (list 'list what)))
-			 t) loop-body))))
-
-     ((memq word '(nconc nconcing append appending))
-      (let ((what (cl-pop args))
-	    (var (cl-loop-handle-accum nil 'nreverse)))
-	(cl-push (list 'progn
-		       (list 'setq var
-			     (if (eq var loop-accum-var)
-				 (list 'nconc
-				       (list (if (memq word '(nconc nconcing))
-						 'nreverse 'reverse)
-					     what)
-				       var)
-			       (list (if (memq word '(nconc nconcing))
-					 'nconc 'append)
-				     var what))) t) loop-body)))
-
-     ((memq word '(concat concating))
-      (let ((what (cl-pop args))
-	    (var (cl-loop-handle-accum "")))
-	(cl-push (list 'progn (list 'callf 'concat var what) t) loop-body)))
-
-     ((memq word '(vconcat vconcating))
-      (let ((what (cl-pop args))
-	    (var (cl-loop-handle-accum [])))
-	(cl-push (list 'progn (list 'callf 'vconcat var what) t) loop-body)))
-
-     ((memq word '(sum summing))
-      (let ((what (cl-pop args))
-	    (var (cl-loop-handle-accum 0)))
-	(cl-push (list 'progn (list 'incf var what) t) loop-body)))
-
-     ((memq word '(count counting))
-      (let ((what (cl-pop args))
-	    (var (cl-loop-handle-accum 0)))
-	(cl-push (list 'progn (list 'if what (list 'incf var)) t) loop-body)))
-
-     ((memq word '(minimize minimizing maximize maximizing))
-      (let* ((what (cl-pop args))
-	     (temp (if (cl-simple-expr-p what) what (gensym)))
-	     (var (cl-loop-handle-accum nil))
-	     (func (intern (substring (symbol-name word) 0 3)))
-	     (set (list 'setq var (list 'if var (list func var temp) temp))))
-	(cl-push (list 'progn (if (eq temp what) set
-				(list 'let (list (list temp what)) set))
-		       t) loop-body)))
-
-     ((eq word 'with)
-      (let ((bindings nil))
-	(while (progn (cl-push (list (cl-pop args)
-				     (and (eq (car args) '=) (cl-pop2 args)))
-			       bindings)
-		      (eq (car args) 'and))
-	  (cl-pop args))
-	(cl-push (nreverse bindings) loop-bindings)))
-
-     ((eq word 'while)
-      (cl-push (cl-pop args) loop-body))
-
-     ((eq word 'until)
-      (cl-push (list 'not (cl-pop args)) loop-body))
-
-     ((eq word 'always)
-      (or loop-finish-flag (setq loop-finish-flag (gensym)))
-      (cl-push (list 'setq loop-finish-flag (cl-pop args)) loop-body)
-      (setq loop-result t))
-
-     ((eq word 'never)
-      (or loop-finish-flag (setq loop-finish-flag (gensym)))
-      (cl-push (list 'setq loop-finish-flag (list 'not (cl-pop args)))
-	       loop-body)
-      (setq loop-result t))
-
-     ((eq word 'thereis)
-      (or loop-finish-flag (setq loop-finish-flag (gensym)))
-      (or loop-result-var (setq loop-result-var (gensym)))
-      (cl-push (list 'setq loop-finish-flag
-		     (list 'not (list 'setq loop-result-var (cl-pop args))))
-	       loop-body))
-
-     ((memq word '(if when unless))
-      (let* ((cond (cl-pop args))
-	     (then (let ((loop-body nil))
-		     (cl-parse-loop-clause)
-		     (cl-loop-build-ands (nreverse loop-body))))
-	     (else (let ((loop-body nil))
-		     (if (eq (car args) 'else)
-			 (progn (cl-pop args) (cl-parse-loop-clause)))
-		     (cl-loop-build-ands (nreverse loop-body))))
-	     (simple (and (eq (car then) t) (eq (car else) t))))
-	(if (eq (car args) 'end) (cl-pop args))
-	(if (eq word 'unless) (setq then (prog1 else (setq else then))))
-	(let ((form (cons (if simple (cons 'progn (nth 1 then)) (nth 2 then))
-			  (if simple (nth 1 else) (list (nth 2 else))))))
-	  (if (cl-expr-contains form 'it)
-	      (let ((temp (gensym)))
-		(cl-push (list temp) loop-bindings)
-		(setq form (list* 'if (list 'setq temp cond)
-				  (subst temp 'it form))))
-	    (setq form (list* 'if cond form)))
-	  (cl-push (if simple (list 'progn form t) form) loop-body))))
-
-     ((memq word '(do doing))
-      (let ((body nil))
-	(or (consp (car args)) (error "Syntax error on `do' clause"))
-	(while (consp (car args)) (cl-push (cl-pop args) body))
-	(cl-push (cons 'progn (nreverse (cons t body))) loop-body)))
-
-     ((eq word 'return)
-      (or loop-finish-flag (setq loop-finish-flag (gensym)))
-      (or loop-result-var (setq loop-result-var (gensym)))
-      (cl-push (list 'setq loop-result-var (cl-pop args)
-		     loop-finish-flag nil) loop-body))
-
-     (t
-      (let ((handler (and (symbolp word) (get word 'cl-loop-handler))))
-	(or handler (error "Expected a loop keyword, found %s" word))
-	(funcall handler))))
-    (if (eq (car args) 'and)
-	(progn (cl-pop args) (cl-parse-loop-clause)))))
-
-(defun cl-loop-let (specs body par)   ; uses loop-*
-  (let ((p specs) (temps nil) (new nil))
-    (while (and p (or (symbolp (car-safe (car p))) (null (cadar p))))
-      (setq p (cdr p)))
-    (and par p
-	 (progn
-	   (setq par nil p specs)
-	   (while p
-	     (or (cl-const-expr-p (cadar p))
-		 (let ((temp (gensym)))
-		   (cl-push (list temp (cadar p)) temps)
-		   (setcar (cdar p) temp)))
-	     (setq p (cdr p)))))
-    (while specs
-      (if (and (consp (car specs)) (listp (caar specs)))
-	  (let* ((spec (caar specs)) (nspecs nil)
-		 (expr (cadr (cl-pop specs)))
-		 (temp (cdr (or (assq spec loop-destr-temps)
-				(car (cl-push (cons spec (or (last spec 0)
-							     (gensym)))
-					      loop-destr-temps))))))
-	    (cl-push (list temp expr) new)
-	    (while (consp spec)
-	      (cl-push (list (cl-pop spec)
-			     (and expr (list (if spec 'pop 'car) temp)))
-		       nspecs))
-	    (setq specs (nconc (nreverse nspecs) specs)))
-	(cl-push (cl-pop specs) new)))
-    (if (eq body 'setq)
-	(let ((set (cons (if par 'psetq 'setq) (apply 'nconc (nreverse new)))))
-	  (if temps (list 'let* (nreverse temps) set) set))
-      (list* (if par 'let 'let*)
-	     (nconc (nreverse temps) (nreverse new)) body))))
-
-(defun cl-loop-handle-accum (def &optional func)   ; uses args, loop-*
-  (if (eq (car args) 'into)
-      (let ((var (cl-pop2 args)))
-	(or (memq var loop-accum-vars)
-	    (progn (cl-push (list (list var def)) loop-bindings)
-		   (cl-push var loop-accum-vars)))
-	var)
-    (or loop-accum-var
-	(progn
-	  (cl-push (list (list (setq loop-accum-var (gensym)) def))
-		   loop-bindings)
-	  (setq loop-result (if func (list func loop-accum-var)
-			      loop-accum-var))
-	  loop-accum-var))))
-
-(defun cl-loop-build-ands (clauses)
-  (let ((ands nil)
-	(body nil))
-    (while clauses
-      (if (and (eq (car-safe (car clauses)) 'progn)
-	       (eq (car (last (car clauses))) t))
-	  (if (cdr clauses)
-	      (setq clauses (cons (nconc (butlast (car clauses))
-					 (if (eq (car-safe (cadr clauses))
-						 'progn)
-					     (cdadr clauses)
-					   (list (cadr clauses))))
-				  (cddr clauses)))
-	    (setq body (cdr (butlast (cl-pop clauses)))))
-	(cl-push (cl-pop clauses) ands)))
-    (setq ands (or (nreverse ands) (list t)))
-    (list (if (cdr ands) (cons 'and ands) (car ands))
-	  body
-	  (let ((full (if body
-			  (append ands (list (cons 'progn (append body '(t)))))
-			ands)))
-	    (if (cdr full) (cons 'and full) (car full))))))
-
-
-;;; Other iteration control structures.
-
-(defmacro do (steps endtest &rest body)
-  "The Common Lisp `do' loop.
-Format is: (do ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)"
-  (cl-expand-do-loop steps endtest body nil))
-
-(defmacro do* (steps endtest &rest body)
-  "The Common Lisp `do*' loop.
-Format is: (do* ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)"
-  (cl-expand-do-loop steps endtest body t))
-
-(defun cl-expand-do-loop (steps endtest body star)
-  (list 'block nil
-	(list* (if star 'let* 'let)
-	       (mapcar (function (lambda (c)
-				   (if (consp c) (list (car c) (nth 1 c)) c)))
-		       steps)
-	       (list* 'while (list 'not (car endtest))
-		      (append body
-			      (let ((sets (mapcar
-					   (function
-					    (lambda (c)
-					      (and (consp c) (cdr (cdr c))
-						   (list (car c) (nth 2 c)))))
-					   steps)))
-				(setq sets (delq nil sets))
-				(and sets
-				     (list (cons (if (or star (not (cdr sets)))
-						     'setq 'psetq)
-						 (apply 'append sets)))))))
-	       (or (cdr endtest) '(nil)))))
-
-(defmacro dolist (spec &rest body)
-  "(dolist (VAR LIST [RESULT]) BODY...): loop over a list.
-Evaluate BODY with VAR bound to each `car' from LIST, in turn.
-Then evaluate RESULT to get return value, default nil."
-  (let ((temp (gensym "--dolist-temp--")))
-    (list 'block nil
-	  (list* 'let (list (list temp (nth 1 spec)) (car spec))
-		 (list* 'while temp (list 'setq (car spec) (list 'car temp))
-			(append body (list (list 'setq temp
-						 (list 'cdr temp)))))
-		 (if (cdr (cdr spec))
-		     (cons (list 'setq (car spec) nil) (cdr (cdr spec)))
-		   '(nil))))))
-
-(defmacro dotimes (spec &rest body)
-  "(dotimes (VAR COUNT [RESULT]) BODY...): loop a certain number of times.
-Evaluate BODY with VAR bound to successive integers from 0, inclusive,
-to COUNT, exclusive.  Then evaluate RESULT to get return value, default
-nil."
-  (let ((temp (gensym "--dotimes-temp--")))
-    (list 'block nil
-	  (list* 'let (list (list temp (nth 1 spec)) (list (car spec) 0))
-		 (list* 'while (list '< (car spec) temp)
-			(append body (list (list 'incf (car spec)))))
-		 (or (cdr (cdr spec)) '(nil))))))
-
-(defmacro do-symbols (spec &rest body)
-  "(dosymbols (VAR [OBARRAY [RESULT]]) BODY...): loop over all symbols.
-Evaluate BODY with VAR bound to each interned symbol, or to each symbol
-from OBARRAY."
-  ;; Apparently this doesn't have an implicit block.
-  (list 'block nil
-	(list 'let (list (car spec))
-	      (list* 'mapatoms
-		     (list 'function (list* 'lambda (list (car spec)) body))
-		     (and (cadr spec) (list (cadr spec))))
-	      (caddr spec))))
-
-(defmacro do-all-symbols (spec &rest body)
-  (list* 'do-symbols (list (car spec) nil (cadr spec)) body))
-
-
-;;; Assignments.
-
-(defmacro psetq (&rest args)
-  "(psetq SYM VAL SYM VAL ...): set SYMs to the values VALs in parallel.
-This is like `setq', except that all VAL forms are evaluated (in order)
-before assigning any symbols SYM to the corresponding values."
-  (cons 'psetf args))
-
-
-;;; Binding control structures.
-
-(defmacro progv (symbols values &rest body)
-  "(progv SYMBOLS VALUES BODY...): bind SYMBOLS to VALUES dynamically in BODY.
-The forms SYMBOLS and VALUES are evaluated, and must evaluate to lists.
-Each SYMBOL in the first list is bound to the corresponding VALUE in the
-second list (or made unbound if VALUES is shorter than SYMBOLS); then the
-BODY forms are executed and their result is returned.  This is much like
-a `let' form, except that the list of symbols can be computed at run-time."
-  (list 'let '((cl-progv-save nil))
-	(list 'unwind-protect
-	      (list* 'progn (list 'cl-progv-before symbols values) body)
-	      '(cl-progv-after))))
-
-;;; This should really have some way to shadow 'byte-compile properties, etc.
-(defmacro flet (bindings &rest body)
-  "(flet ((FUNC ARGLIST BODY...) ...) FORM...): make temporary function defns.
-This is an analogue of `let' that operates on the function cell of FUNC
-rather than its value cell.  The FORMs are evaluated with the specified
-function definitions in place, then the definitions are undone (the FUNCs
-go back to their previous definitions, or lack thereof)."
-  (list* 'letf*
-	 (mapcar
-	  (function
-	   (lambda (x)
-	     (if (or (and (fboundp (car x))
-			  (eq (car-safe (symbol-function (car x))) 'macro))
-		     (cdr (assq (car x) cl-macro-environment)))
-		 (error "Use `labels', not `flet', to rebind macro names"))
-	     (let ((func (list 'function*
-			       (list 'lambda (cadr x)
-				     (list* 'block (car x) (cddr x))))))
-	       (if (and (cl-compiling-file)
-			(boundp 'byte-compile-function-environment))
-		   (cl-push (cons (car x) (eval func))
-			    byte-compile-function-environment))
-	       (list (list 'symbol-function (list 'quote (car x))) func))))
-	  bindings)
-	 body))
-
-(defmacro labels (bindings &rest body)
-  "(labels ((FUNC ARGLIST BODY...) ...) FORM...): make temporary func bindings.
-This is like `flet', except the bindings are lexical instead of dynamic.
-Unlike `flet', this macro is fully complaint with the Common Lisp standard."
-  (let ((vars nil) (sets nil) (cl-macro-environment cl-macro-environment))
-    (while bindings
-      (let ((var (gensym)))
-	(cl-push var vars)
-	(cl-push (list 'function* (cons 'lambda (cdar bindings))) sets)
-	(cl-push var sets)
-	(cl-push (list (car (cl-pop bindings)) 'lambda '(&rest cl-labels-args)
-		       (list 'list* '(quote funcall) (list 'quote var)
-			     'cl-labels-args))
-		 cl-macro-environment)))
-    (cl-macroexpand-all (list* 'lexical-let vars (cons (cons 'setq sets) body))
-			cl-macro-environment)))
-
-;; The following ought to have a better definition for use with newer
-;; byte compilers.
-(defmacro macrolet (bindings &rest body)
-  "(macrolet ((NAME ARGLIST BODY...) ...) FORM...): make temporary macro defns.
-This is like `flet', but for macros instead of functions."
-  (if (cdr bindings)
-      (list 'macrolet
-	    (list (car bindings)) (list* 'macrolet (cdr bindings) body))
-    (if (null bindings) (cons 'progn body)
-      (let* ((name (caar bindings))
-	     (res (cl-transform-lambda (cdar bindings) name)))
-	(eval (car res))
-	(cl-macroexpand-all (cons 'progn body)
-			    (cons (list* name 'lambda (cdr res))
-				  cl-macro-environment))))))
-
-(defmacro symbol-macrolet (bindings &rest body)
-  "(symbol-macrolet ((NAME EXPANSION) ...) FORM...): make symbol macro defns.
-Within the body FORMs, references to the variable NAME will be replaced
-by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...)."
-  (if (cdr bindings)
-      (list 'symbol-macrolet
-	    (list (car bindings)) (list* 'symbol-macrolet (cdr bindings) body))
-    (if (null bindings) (cons 'progn body)
-      (cl-macroexpand-all (cons 'progn body)
-			  (cons (list (symbol-name (caar bindings))
-				      (cadar bindings))
-				cl-macro-environment)))))
-
-(defvar cl-closure-vars nil)
-(defmacro lexical-let (bindings &rest body)
-  "(lexical-let BINDINGS BODY...): like `let', but lexically scoped.
-The main visible difference is that lambdas inside BODY will create
-lexical closures as in Common Lisp."
-  (let* ((cl-closure-vars cl-closure-vars)
-	 (vars (mapcar (function
-			(lambda (x)
-			  (or (consp x) (setq x (list x)))
-			  (cl-push (gensym (format "--%s--" (car x)))
-				   cl-closure-vars)
-			  (set (car cl-closure-vars) [bad-lexical-ref])
-			  (list (car x) (cadr x) (car cl-closure-vars))))
-		       bindings))
-	 (ebody 
-	  (cl-macroexpand-all
-	   (cons 'progn body)
-	   (nconc (mapcar (function (lambda (x)
-				      (list (symbol-name (car x))
-					    (list 'symbol-value (caddr x))
-					    t))) vars)
-		  (list '(defun . cl-defun-expander))
-		  cl-macro-environment))))
-    (if (not (get (car (last cl-closure-vars)) 'used))
-	(list 'let (mapcar (function (lambda (x)
-				       (list (caddr x) (cadr x)))) vars)
-	      (sublis (mapcar (function (lambda (x)
-					  (cons (caddr x)
-						(list 'quote (caddr x)))))
-			      vars)
-		      ebody))
-      (list 'let (mapcar (function (lambda (x)
-				     (list (caddr x)
-					   (list 'make-symbol
-						 (format "--%s--" (car x))))))
-			 vars)
-	    (apply 'append '(setf)
-		   (mapcar (function
-			    (lambda (x)
-			      (list (list 'symbol-value (caddr x)) (cadr x))))
-			   vars))
-	    ebody))))
-
-(defmacro lexical-let* (bindings &rest body)
-  "(lexical-let* BINDINGS BODY...): like `let*', but lexically scoped.
-The main visible difference is that lambdas inside BODY will create
-lexical closures as in Common Lisp."
-  (if (null bindings) (cons 'progn body)
-    (setq bindings (reverse bindings))
-    (while bindings
-      (setq body (list (list* 'lexical-let (list (cl-pop bindings)) body))))
-    (car body)))
-
-(defun cl-defun-expander (func &rest rest)
-  (list 'progn
-	(list 'defalias (list 'quote func)
-	      (list 'function (cons 'lambda rest)))
-	(list 'quote func)))
-
-
-;;; Multiple values.
-
-(defmacro multiple-value-bind (vars form &rest body)
-  "(multiple-value-bind (SYM SYM...) FORM BODY): collect multiple return values.
-FORM must return a list; the BODY is then executed with the first N elements
-of this list bound (`let'-style) to each of the symbols SYM in turn.  This
-is analogous to the Common Lisp `multiple-value-bind' macro, using lists to
-simulate true multiple return values.  For compatibility, (values A B C) is
-a synonym for (list A B C)."
-  (let ((temp (gensym)) (n -1))
-    (list* 'let* (cons (list temp form)
-		       (mapcar (function
-				(lambda (v)
-				  (list v (list 'nth (setq n (1+ n)) temp))))
-			       vars))
-	   body)))
-
-(defmacro multiple-value-setq (vars form)
-  "(multiple-value-setq (SYM SYM...) FORM): collect multiple return values.
-FORM must return a list; the first N elements of this list are stored in
-each of the symbols SYM in turn.  This is analogous to the Common Lisp
-`multiple-value-setq' macro, using lists to simulate true multiple return
-values.  For compatibility, (values A B C) is a synonym for (list A B C)."
-  (cond ((null vars) (list 'progn form nil))
-	((null (cdr vars)) (list 'setq (car vars) (list 'car form)))
-	(t
-	 (let* ((temp (gensym)) (n 0))
-	   (list 'let (list (list temp form))
-		 (list 'prog1 (list 'setq (cl-pop vars) (list 'car temp))
-		       (cons 'setq (apply 'nconc
-					  (mapcar (function
-						   (lambda (v)
-						     (list v (list
-							      'nth
-							      (setq n (1+ n))
-							      temp))))
-						  vars)))))))))
-
-
-;;; Declarations.
-
-(defmacro locally (&rest body) (cons 'progn body))
-(defmacro the (type form) form)
-
-(defvar cl-proclaim-history t)    ; for future compilers
-(defvar cl-declare-stack t)       ; for future compilers
-
-(defun cl-do-proclaim (spec hist)
-  (and hist (listp cl-proclaim-history) (cl-push spec cl-proclaim-history))
-  (cond ((eq (car-safe spec) 'special)
-	 (if (boundp 'byte-compile-bound-variables)
-	     (setq byte-compile-bound-variables
-		   (append (cdr spec) byte-compile-bound-variables))))
-
-	((eq (car-safe spec) 'inline)
-	 (while (setq spec (cdr spec))
-	   (or (memq (get (car spec) 'byte-optimizer)
-		     '(nil byte-compile-inline-expand))
-	       (error "%s already has a byte-optimizer, can't make it inline"
-		      (car spec)))
-	   (put (car spec) 'byte-optimizer 'byte-compile-inline-expand)))
-
-	((eq (car-safe spec) 'notinline)
-	 (while (setq spec (cdr spec))
-	   (if (eq (get (car spec) 'byte-optimizer)
-		   'byte-compile-inline-expand)
-	       (put (car spec) 'byte-optimizer nil))))
-
-	((eq (car-safe spec) 'optimize)
-	 (let ((speed (assq (nth 1 (assq 'speed (cdr spec)))
-			    '((0 nil) (1 t) (2 t) (3 t))))
-	       (safety (assq (nth 1 (assq 'safety (cdr spec)))
-			     '((0 t) (1 t) (2 t) (3 nil)))))
-	   (if speed (setq cl-optimize-speed (car speed)
-			   byte-optimize (nth 1 speed)))
-	   (if safety (setq cl-optimize-safety (car safety)
-			    byte-compile-delete-errors (nth 1 safety)))))
-
-	((and (eq (car-safe spec) 'warn) (boundp 'byte-compile-warnings))
-	 (if (eq byte-compile-warnings t)
-	     (setq byte-compile-warnings byte-compile-warning-types))
-	 (while (setq spec (cdr spec))
-	   (if (consp (car spec))
-	       (if (eq (cadar spec) 0)
-		   (setq byte-compile-warnings
-			 (delq (caar spec) byte-compile-warnings))
-		 (setq byte-compile-warnings
-		       (adjoin (caar spec) byte-compile-warnings)))))))
-  nil)
-
-;;; Process any proclamations made before cl-macs was loaded.
-(defvar cl-proclaims-deferred)
-(let ((p (reverse cl-proclaims-deferred)))
-  (while p (cl-do-proclaim (cl-pop p) t))
-  (setq cl-proclaims-deferred nil))
-
-(defmacro declare (&rest specs)
-  (if (cl-compiling-file)
-      (while specs
-	(if (listp cl-declare-stack) (cl-push (car specs) cl-declare-stack))
-	(cl-do-proclaim (cl-pop specs) nil)))
-  nil)
-
-
-
-;;; Generalized variables.
-
-(defmacro define-setf-method (func args &rest body)
-  "(define-setf-method NAME ARGLIST BODY...): define a `setf' method.
-This method shows how to handle `setf's to places of the form (NAME ARGS...).
-The argument forms ARGS are bound according to ARGLIST, as if NAME were
-going to be expanded as a macro, then the BODY forms are executed and must
-return a list of five elements: a temporary-variables list, a value-forms
-list, a store-variables list (of length one), a store-form, and an access-
-form.  See `defsetf' for a simpler way to define most setf-methods."
-  (append '(eval-when (compile load eval))
-	  (if (stringp (car body))
-	      (list (list 'put (list 'quote func) '(quote setf-documentation)
-			  (cl-pop body))))
-	  (list (cl-transform-function-property
-		 func 'setf-method (cons args body)))))
-
-(defmacro defsetf (func arg1 &rest args)
-  "(defsetf NAME FUNC): define a `setf' method.
-This macro is an easy-to-use substitute for `define-setf-method' that works
-well for simple place forms.  In the simple `defsetf' form, `setf's of
-the form (setf (NAME ARGS...) VAL) are transformed to function or macro
-calls of the form (FUNC ARGS... VAL).  Example: (defsetf aref aset).
-Alternate form: (defsetf NAME ARGLIST (STORE) BODY...).
-Here, the above `setf' call is expanded by binding the argument forms ARGS
-according to ARGLIST, binding the value form VAL to STORE, then executing
-BODY, which must return a Lisp form that does the necessary `setf' operation.
-Actually, ARGLIST and STORE may be bound to temporary variables which are
-introduced automatically to preserve proper execution order of the arguments.
-Example: (defsetf nth (n x) (v) (list 'setcar (list 'nthcdr n x) v))."
-  (if (listp arg1)
-      (let* ((largs nil) (largsr nil)
-	     (temps nil) (tempsr nil)
-	     (restarg nil) (rest-temps nil)
-	     (store-var (car (prog1 (car args) (setq args (cdr args)))))
-	     (store-temp (intern (format "--%s--temp--" store-var)))
-	     (lets1 nil) (lets2 nil)
-	     (docstr nil) (p arg1))
-	(if (stringp (car args))
-	    (setq docstr (prog1 (car args) (setq args (cdr args)))))
-	(while (and p (not (eq (car p) '&aux)))
-	  (if (eq (car p) '&rest)
-	      (setq p (cdr p) restarg (car p))
-	    (or (memq (car p) '(&optional &key &allow-other-keys))
-		(setq largs (cons (if (consp (car p)) (car (car p)) (car p))
-				  largs)
-		      temps (cons (intern (format "--%s--temp--" (car largs)))
-				  temps))))
-	  (setq p (cdr p)))
-	(setq largs (nreverse largs) temps (nreverse temps))
-	(if restarg
-	    (setq largsr (append largs (list restarg))
-		  rest-temps (intern (format "--%s--temp--" restarg))
-		  tempsr (append temps (list rest-temps)))
-	  (setq largsr largs tempsr temps))
-	(let ((p1 largs) (p2 temps))
-	  (while p1
-	    (setq lets1 (cons (list (car p2)
-				    (list 'gensym (format "--%s--" (car p1))))
-			      lets1)
-		  lets2 (cons (list (car p1) (car p2)) lets2)
-		  p1 (cdr p1) p2 (cdr p2))))
-	(if restarg (setq lets2 (cons (list restarg rest-temps) lets2)))
-	(append (list 'define-setf-method func arg1)
-		(and docstr (list docstr))
-		(list
-		 (list 'let*
-		       (nreverse
-			(cons (list store-temp
-				    (list 'gensym (format "--%s--" store-var)))
-			      (if restarg
-				  (append
-				   (list
-				    (list rest-temps
-					  (list 'mapcar '(quote gensym)
-						restarg)))
-				   lets1)
-				lets1)))
-		       (list 'list  ; 'values
-			     (cons (if restarg 'list* 'list) tempsr)
-			     (cons (if restarg 'list* 'list) largsr)
-			     (list 'list store-temp)
-			     (cons 'let*
-				   (cons (nreverse
-					  (cons (list store-var store-temp)
-						lets2))
-					 args))
-			     (cons (if restarg 'list* 'list)
-				   (cons (list 'quote func) tempsr)))))))
-    (list 'defsetf func '(&rest args) '(store)
-	  (let ((call (list 'cons (list 'quote arg1)
-			    '(append args (list store)))))
-	    (if (car args)
-		(list 'list '(quote progn) call 'store)
-	      call)))))
-
-;;; Some standard place types from Common Lisp.
-(defsetf aref aset)
-(defsetf car setcar)
-(defsetf cdr setcdr)
-(defsetf elt (seq n) (store)
-  (list 'if (list 'listp seq) (list 'setcar (list 'nthcdr n seq) store)
-	(list 'aset seq n store)))
-(defsetf get put)
-(defsetf get* (x y &optional d) (store) (list 'put x y store))
-(defsetf gethash (x h &optional d) (store) (list 'cl-puthash x store h))
-(defsetf nth (n x) (store) (list 'setcar (list 'nthcdr n x) store))
-(defsetf subseq (seq start &optional end) (new)
-  (list 'progn (list 'replace seq new ':start1 start ':end1 end) new))
-(defsetf symbol-function fset)
-(defsetf symbol-plist setplist)
-(defsetf symbol-value set)
-
-;;; Various car/cdr aliases.  Note that `cadr' is handled specially.
-(defsetf first setcar)
-(defsetf second (x) (store) (list 'setcar (list 'cdr x) store))
-(defsetf third (x) (store) (list 'setcar (list 'cddr x) store))
-(defsetf fourth (x) (store) (list 'setcar (list 'cdddr x) store))
-(defsetf fifth (x) (store) (list 'setcar (list 'nthcdr 4 x) store))
-(defsetf sixth (x) (store) (list 'setcar (list 'nthcdr 5 x) store))
-(defsetf seventh (x) (store) (list 'setcar (list 'nthcdr 6 x) store))
-(defsetf eighth (x) (store) (list 'setcar (list 'nthcdr 7 x) store))
-(defsetf ninth (x) (store) (list 'setcar (list 'nthcdr 8 x) store))
-(defsetf tenth (x) (store) (list 'setcar (list 'nthcdr 9 x) store))
-(defsetf rest setcdr)
-
-;;; Some more Emacs-related place types.
-(defsetf buffer-file-name set-visited-file-name t)
-(defsetf buffer-modified-p set-buffer-modified-p t)
-(defsetf buffer-name rename-buffer t)
-(defsetf buffer-string () (store)
-  (list 'progn '(erase-buffer) (list 'insert store)))
-(defsetf buffer-substring cl-set-buffer-substring)
-(defsetf current-buffer set-buffer)
-(defsetf current-case-table set-case-table)
-(defsetf current-column move-to-column t)
-(defsetf current-global-map use-global-map t)
-(defsetf current-input-mode () (store)
-  (list 'progn (list 'apply 'set-input-mode store) store))
-(defsetf current-local-map use-local-map t)
-(defsetf current-window-configuration set-window-configuration t)
-(defsetf default-file-modes set-default-file-modes t)
-(defsetf default-value set-default)
-(defsetf documentation-property put)
-(defsetf extent-data set-extent-data)
-(defsetf extent-face set-extent-face)
-(defsetf extent-priority set-extent-priority)
-(defsetf extent-end-position (ext) (store)
-  (list 'progn (list 'set-extent-endpoints (list 'extent-start-position ext)
-		     store) store))
-(defsetf extent-start-position (ext) (store)
-  (list 'progn (list 'set-extent-endpoints store
-		     (list 'extent-end-position ext)) store))
-(defsetf face-background (f &optional s) (x) (list 'set-face-background f x s))
-(defsetf face-background-pixmap (f &optional s) (x)
-  (list 'set-face-background-pixmap f x s))
-(defsetf face-font (f &optional s) (x) (list 'set-face-font f x s))
-(defsetf face-foreground (f &optional s) (x) (list 'set-face-foreground f x s))
-(defsetf face-underline-p (f &optional s) (x)
-  (list 'set-face-underline-p f x s))
-(defsetf file-modes set-file-modes t)
-(defsetf frame-height set-screen-height t)
-(defsetf frame-parameters modify-frame-parameters t)
-(defsetf frame-visible-p cl-set-frame-visible-p)
-(defsetf frame-width set-screen-width t)
-(defsetf getenv setenv t)
-(defsetf get-register set-register)
-(defsetf global-key-binding global-set-key)
-(defsetf keymap-parent set-keymap-parent)
-(defsetf local-key-binding local-set-key)
-(defsetf mark set-mark t)
-(defsetf mark-marker set-mark t)
-(defsetf marker-position set-marker t)
-(defsetf match-data store-match-data t)
-(defsetf mouse-position (scr) (store)
-  (list 'set-mouse-position scr (list 'car store) (list 'cadr store)
-	(list 'cddr store)))
-(defsetf overlay-get overlay-put)
-(defsetf overlay-start (ov) (store)
-  (list 'progn (list 'move-overlay ov store (list 'overlay-end ov)) store))
-(defsetf overlay-end (ov) (store)
-  (list 'progn (list 'move-overlay ov (list 'overlay-start ov) store) store))
-(defsetf point goto-char)
-(defsetf point-marker goto-char t)
-(defsetf point-max () (store)
-  (list 'progn (list 'narrow-to-region '(point-min) store) store))
-(defsetf point-min () (store)
-  (list 'progn (list 'narrow-to-region store '(point-max)) store))
-(defsetf process-buffer set-process-buffer)
-(defsetf process-filter set-process-filter)
-(defsetf process-sentinel set-process-sentinel)
-(defsetf read-mouse-position (scr) (store)
-  (list 'set-mouse-position scr (list 'car store) (list 'cdr store)))
-(defsetf screen-height set-screen-height t)
-(defsetf screen-width set-screen-width t)
-(defsetf selected-window select-window)
-(defsetf selected-screen select-screen)
-(defsetf selected-frame select-frame)
-(defsetf standard-case-table set-standard-case-table)
-(defsetf syntax-table set-syntax-table)
-(defsetf visited-file-modtime set-visited-file-modtime t)
-(defsetf window-buffer set-window-buffer t)
-(defsetf window-display-table set-window-display-table t)
-(defsetf window-dedicated-p set-window-dedicated-p t)
-(defsetf window-height () (store)
-  (list 'progn (list 'enlarge-window (list '- store '(window-height))) store))
-(defsetf window-hscroll set-window-hscroll)
-(defsetf window-point set-window-point)
-(defsetf window-start set-window-start)
-(defsetf window-width () (store)
-  (list 'progn (list 'enlarge-window (list '- store '(window-width)) t) store))
-(defsetf x-get-cutbuffer x-store-cutbuffer t)
-(defsetf x-get-cut-buffer x-store-cut-buffer t)   ; groan.
-(defsetf x-get-secondary-selection x-own-secondary-selection t)
-(defsetf x-get-selection x-own-selection t)
-
-;;; More complex setf-methods.
-;;; These should take &environment arguments, but since full arglists aren't
-;;; available while compiling cl-macs, we fake it by referring to the global
-;;; variable cl-macro-environment directly.
-
-(define-setf-method apply (func arg1 &rest rest)
-  (or (and (memq (car-safe func) '(quote function function*))
-	   (symbolp (car-safe (cdr-safe func))))
-      (error "First arg to apply in setf is not (function SYM): %s" func))
-  (let* ((form (cons (nth 1 func) (cons arg1 rest)))
-	 (method (get-setf-method form cl-macro-environment)))
-    (list (car method) (nth 1 method) (nth 2 method)
-	  (cl-setf-make-apply (nth 3 method) (cadr func) (car method))
-	  (cl-setf-make-apply (nth 4 method) (cadr func) (car method)))))
-
-(defun cl-setf-make-apply (form func temps)
-  (if (eq (car form) 'progn)
-      (list* 'progn (cl-setf-make-apply (cadr form) func temps) (cddr form))
-    (or (equal (last form) (last temps))
-	(error "%s is not suitable for use with setf-of-apply" func))
-    (list* 'apply (list 'quote (car form)) (cdr form))))
-
-(define-setf-method nthcdr (n place)
-  (let ((method (get-setf-method place cl-macro-environment))
-	(n-temp (gensym "--nthcdr-n--"))
-	(store-temp (gensym "--nthcdr-store--")))
-    (list (cons n-temp (car method))
-	  (cons n (nth 1 method))
-	  (list store-temp)
-	  (list 'let (list (list (car (nth 2 method))
-				 (list 'cl-set-nthcdr n-temp (nth 4 method)
-				       store-temp)))
-		(nth 3 method) store-temp)
-	  (list 'nthcdr n-temp (nth 4 method)))))
-
-(define-setf-method getf (place tag &optional def)
-  (let ((method (get-setf-method place cl-macro-environment))
-	(tag-temp (gensym "--getf-tag--"))
-	(def-temp (gensym "--getf-def--"))
-	(store-temp (gensym "--getf-store--")))
-    (list (append (car method) (list tag-temp def-temp))
-	  (append (nth 1 method) (list tag def))
-	  (list store-temp)
-	  (list 'let (list (list (car (nth 2 method))
-				 (list 'cl-set-getf (nth 4 method)
-				       tag-temp store-temp)))
-		(nth 3 method) store-temp)
-	  (list 'getf (nth 4 method) tag-temp def-temp))))
-
-(define-setf-method substring (place from &optional to)
-  (let ((method (get-setf-method place cl-macro-environment))
-	(from-temp (gensym "--substring-from--"))
-	(to-temp (gensym "--substring-to--"))
-	(store-temp (gensym "--substring-store--")))
-    (list (append (car method) (list from-temp to-temp))
-	  (append (nth 1 method) (list from to))
-	  (list store-temp)
-	  (list 'let (list (list (car (nth 2 method))
-				 (list 'cl-set-substring (nth 4 method)
-				       from-temp to-temp store-temp)))
-		(nth 3 method) store-temp)
-	  (list 'substring (nth 4 method) from-temp to-temp))))
-
-;;; Getting and optimizing setf-methods.
-(defun get-setf-method (place &optional env)
-  "Return a list of five values describing the setf-method for PLACE.
-PLACE may be any Lisp form which can appear as the PLACE argument to
-a macro like `setf' or `incf'."
-  (if (symbolp place)
-      (let ((temp (gensym "--setf--")))
-	(list nil nil (list temp) (list 'setq place temp) place))
-    (or (and (symbolp (car place))
-	     (let* ((func (car place))
-		    (name (symbol-name func))
-		    (method (get func 'setf-method))
-		    (case-fold-search nil))
-	       (or (and method
-			(let ((cl-macro-environment env))
-			  (setq method (apply method (cdr place))))
-			(if (and (consp method) (= (length method) 5))
-			    method
-			  (error "Setf-method for %s returns malformed method"
-				 func)))
-		   (and (save-match-data
-			  (string-match "\\`c[ad][ad][ad]?[ad]?r\\'" name))
-			(get-setf-method (compiler-macroexpand place)))
-		   (and (eq func 'edebug-after)
-			(get-setf-method (nth (1- (length place)) place)
-					 env)))))
-	(if (eq place (setq place (macroexpand place env)))
-	    (if (and (symbolp (car place)) (fboundp (car place))
-		     (symbolp (symbol-function (car place))))
-		(get-setf-method (cons (symbol-function (car place))
-				       (cdr place)) env)
-	      (error "No setf-method known for %s" (car place)))
-	  (get-setf-method place env)))))
-
-(defun cl-setf-do-modify (place opt-expr)
-  (let* ((method (get-setf-method place cl-macro-environment))
-	 (temps (car method)) (values (nth 1 method))
-	 (lets nil) (subs nil)
-	 (optimize (and (not (eq opt-expr 'no-opt))
-			(or (and (not (eq opt-expr 'unsafe))
-				 (cl-safe-expr-p opt-expr))
-			    (cl-setf-simple-store-p (car (nth 2 method))
-						    (nth 3 method)))))
-	 (simple (and optimize (consp place) (cl-simple-exprs-p (cdr place)))))
-    (while values
-      (if (or simple (cl-const-expr-p (car values)))
-	  (cl-push (cons (cl-pop temps) (cl-pop values)) subs)
-	(cl-push (list (cl-pop temps) (cl-pop values)) lets)))
-    (list (nreverse lets)
-	  (cons (car (nth 2 method)) (sublis subs (nth 3 method)))
-	  (sublis subs (nth 4 method)))))
-
-(defun cl-setf-do-store (spec val)
-  (let ((sym (car spec))
-	(form (cdr spec)))
-    (if (or (cl-const-expr-p val)
-	    (and (cl-simple-expr-p val) (eq (cl-expr-contains form sym) 1))
-	    (cl-setf-simple-store-p sym form))
-	(subst val sym form)
-      (list 'let (list (list sym val)) form))))
-
-(defun cl-setf-simple-store-p (sym form)
-  (and (consp form) (eq (cl-expr-contains form sym) 1)
-       (eq (nth (1- (length form)) form) sym)
-       (symbolp (car form)) (fboundp (car form))
-       (not (eq (car-safe (symbol-function (car form))) 'macro))))
-
-;;; The standard modify macros.
-(defmacro setf (&rest args)
-  "(setf PLACE VAL PLACE VAL ...): set each PLACE to the value of its VAL.
-This is a generalized version of `setq'; the PLACEs may be symbolic
-references such as (car x) or (aref x i), as well as plain symbols.
-For example, (setf (cadar x) y) is equivalent to (setcar (cdar x) y).
-The return value is the last VAL in the list."
-  (if (cdr (cdr args))
-      (let ((sets nil))
-	(while args (cl-push (list 'setf (cl-pop args) (cl-pop args)) sets))
-	(cons 'progn (nreverse sets)))
-    (if (symbolp (car args))
-	(and args (cons 'setq args))
-      (let* ((method (cl-setf-do-modify (car args) (nth 1 args)))
-	     (store (cl-setf-do-store (nth 1 method) (nth 1 args))))
-	(if (car method) (list 'let* (car method) store) store)))))
-
-(defmacro psetf (&rest args)
-  "(psetf PLACE VAL PLACE VAL ...): set PLACEs to the values VALs in parallel.
-This is like `setf', except that all VAL forms are evaluated (in order)
-before assigning any PLACEs to the corresponding values."
-  (let ((p args) (simple t) (vars nil))
-    (while p
-      (if (or (not (symbolp (car p))) (cl-expr-depends-p (nth 1 p) vars))
-	  (setq simple nil))
-      (if (memq (car p) vars)
-	  (error "Destination duplicated in psetf: %s" (car p)))
-      (cl-push (cl-pop p) vars)
-      (or p (error "Odd number of arguments to psetf"))
-      (cl-pop p))
-    (if simple
-	(list 'progn (cons 'setf args) nil)
-      (setq args (reverse args))
-      (let ((expr (list 'setf (cadr args) (car args))))
-	(while (setq args (cddr args))
-	  (setq expr (list 'setf (cadr args) (list 'prog1 (car args) expr))))
-	(list 'progn expr nil)))))
-
-(defun cl-do-pop (place)
-  (if (cl-simple-expr-p place)
-      (list 'prog1 (list 'car place) (list 'setf place (list 'cdr place)))
-    (let* ((method (cl-setf-do-modify place t))
-	   (temp (gensym "--pop--")))
-      (list 'let*
-	    (append (car method)
-		    (list (list temp (nth 2 method))))
-	    (list 'prog1
-		  (list 'car temp)
-		  (cl-setf-do-store (nth 1 method) (list 'cdr temp)))))))
-
-(defmacro remf (place tag)
-  "(remf PLACE TAG): remove TAG from property list PLACE.
-PLACE may be a symbol, or any generalized variable allowed by `setf'.
-The form returns true if TAG was found and removed, nil otherwise."
-  (let* ((method (cl-setf-do-modify place t))
-	 (tag-temp (and (not (cl-const-expr-p tag)) (gensym "--remf-tag--")))
-	 (val-temp (and (not (cl-simple-expr-p place))
-			(gensym "--remf-place--")))
-	 (ttag (or tag-temp tag))
-	 (tval (or val-temp (nth 2 method))))
-    (list 'let*
-	  (append (car method)
-		  (and val-temp (list (list val-temp (nth 2 method))))
-		  (and tag-temp (list (list tag-temp tag))))
-	  (list 'if (list 'eq ttag (list 'car tval))
-		(list 'progn
-		      (cl-setf-do-store (nth 1 method) (list 'cddr tval))
-		      t)
-		(list 'cl-do-remf tval ttag)))))
-
-(defmacro shiftf (place &rest args)
-  "(shiftf PLACE PLACE... VAL): shift left among PLACEs.
-Example: (shiftf A B C) sets A to B, B to C, and returns the old A.
-Each PLACE may be a symbol, or any generalized variable allowed by `setf'."
-  (if (not (memq nil (mapcar 'symbolp (butlast (cons place args)))))
-      (list* 'prog1 place
-	     (let ((sets nil))
-	       (while args
-		 (cl-push (list 'setq place (car args)) sets)
-		 (setq place (cl-pop args)))
-	       (nreverse sets)))
-    (let* ((places (reverse (cons place args)))
-	   (form (cl-pop places)))
-      (while places
-	(let ((method (cl-setf-do-modify (cl-pop places) 'unsafe)))
-	  (setq form (list 'let* (car method)
-			   (list 'prog1 (nth 2 method)
-				 (cl-setf-do-store (nth 1 method) form))))))
-      form)))
-
-(defmacro rotatef (&rest args)
-  "(rotatef PLACE...): rotate left among PLACEs.
-Example: (rotatef A B C) sets A to B, B to C, and C to A.  It returns nil.
-Each PLACE may be a symbol, or any generalized variable allowed by `setf'."
-  (if (not (memq nil (mapcar 'symbolp args)))
-      (and (cdr args)
-	   (let ((sets nil)
-		 (first (car args)))
-	     (while (cdr args)
-	       (setq sets (nconc sets (list (cl-pop args) (car args)))))
-	     (nconc (list 'psetf) sets (list (car args) first))))
-    (let* ((places (reverse args))
-	   (temp (gensym "--rotatef--"))
-	   (form temp))
-      (while (cdr places)
-	(let ((method (cl-setf-do-modify (cl-pop places) 'unsafe)))
-	  (setq form (list 'let* (car method)
-			   (list 'prog1 (nth 2 method)
-				 (cl-setf-do-store (nth 1 method) form))))))
-      (let ((method (cl-setf-do-modify (car places) 'unsafe)))
-	(list 'let* (append (car method) (list (list temp (nth 2 method))))
-	      (cl-setf-do-store (nth 1 method) form) nil)))))
-
-(defmacro letf (bindings &rest body)
-  "(letf ((PLACE VALUE) ...) BODY...): temporarily bind to PLACEs.
-This is the analogue of `let', but with generalized variables (in the
-sense of `setf') for the PLACEs.  Each PLACE is set to the corresponding
-VALUE, then the BODY forms are executed.  On exit, either normally or
-because of a `throw' or error, the PLACEs are set back to their original
-values.  Note that this macro is *not* available in Common Lisp.
-As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)',
-the PLACE is not modified before executing BODY."
-  (if (and (not (cdr bindings)) (cdar bindings) (symbolp (caar bindings)))
-      (list* 'let bindings body)
-    (let ((lets nil) (sets nil)
-	  (unsets nil) (rev (reverse bindings)))
-      (while rev
-	(let* ((place (if (symbolp (caar rev))
-			  (list 'symbol-value (list 'quote (caar rev)))
-			(caar rev)))
-	       (value (cadar rev))
-	       (method (cl-setf-do-modify place 'no-opt))
-	       (save (gensym "--letf-save--"))
-	       (bound (and (memq (car place) '(symbol-value symbol-function))
-			   (gensym "--letf-bound--")))
-	       (temp (and (not (cl-const-expr-p value)) (cdr bindings)
-			  (gensym "--letf-val--"))))
-	  (setq lets (nconc (car method)
-			    (if bound
-				(list (list bound
-					    (list (if (eq (car place)
-							  'symbol-value)
-						      'boundp 'fboundp)
-						  (nth 1 (nth 2 method))))
-				      (list save (list 'and bound
-						       (nth 2 method))))
-			      (list (list save (nth 2 method))))
-			    (and temp (list (list temp value)))
-			    lets)
-		body (list
-		      (list 'unwind-protect
-			    (cons 'progn
-				  (if (cdr (car rev))
-				      (cons (cl-setf-do-store (nth 1 method)
-							      (or temp value))
-					    body)
-				    body))
-			    (if bound
-				(list 'if bound
-				      (cl-setf-do-store (nth 1 method) save)
-				      (list (if (eq (car place) 'symbol-value)
-						'makunbound 'fmakunbound)
-					    (nth 1 (nth 2 method))))
-			      (cl-setf-do-store (nth 1 method) save))))
-		rev (cdr rev))))
-      (list* 'let* lets body))))
-
-(defmacro letf* (bindings &rest body)
-  "(letf* ((PLACE VALUE) ...) BODY...): temporarily bind to PLACEs.
-This is the analogue of `let*', but with generalized variables (in the
-sense of `setf') for the PLACEs.  Each PLACE is set to the corresponding
-VALUE, then the BODY forms are executed.  On exit, either normally or
-because of a `throw' or error, the PLACEs are set back to their original
-values.  Note that this macro is *not* available in Common Lisp.
-As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)',
-the PLACE is not modified before executing BODY."
-  (if (null bindings)
-      (cons 'progn body)
-    (setq bindings (reverse bindings))
-    (while bindings
-      (setq body (list (list* 'letf (list (cl-pop bindings)) body))))
-    (car body)))
-
-(defmacro callf (func place &rest args)
-  "(callf FUNC PLACE ARGS...): set PLACE to (FUNC PLACE ARGS...).
-FUNC should be an unquoted function name.  PLACE may be a symbol,
-or any generalized variable allowed by `setf'."
-  (let* ((method (cl-setf-do-modify place (cons 'list args)))
-	 (rargs (cons (nth 2 method) args)))
-    (list 'let* (car method)
-	  (cl-setf-do-store (nth 1 method)
-			    (if (symbolp func) (cons func rargs)
-			      (list* 'funcall (list 'function func)
-				     rargs))))))
-
-(defmacro callf2 (func arg1 place &rest args)
-  "(callf2 FUNC ARG1 PLACE ARGS...): set PLACE to (FUNC ARG1 PLACE ARGS...).
-Like `callf', but PLACE is the second argument of FUNC, not the first."
-  (if (and (cl-safe-expr-p arg1) (cl-simple-expr-p place) (symbolp func))
-      (list 'setf place (list* func arg1 place args))
-    (let* ((method (cl-setf-do-modify place (cons 'list args)))
-	   (temp (and (not (cl-const-expr-p arg1)) (gensym "--arg1--")))
-	   (rargs (list* (or temp arg1) (nth 2 method) args)))
-      (list 'let* (append (and temp (list (list temp arg1))) (car method))
-	    (cl-setf-do-store (nth 1 method)
-			      (if (symbolp func) (cons func rargs)
-				(list* 'funcall (list 'function func)
-				       rargs)))))))
-
-(defmacro define-modify-macro (name arglist func &optional doc)
-  "(define-modify-macro NAME ARGLIST FUNC): define a `setf'-like modify macro.
-If NAME is called, it combines its PLACE argument with the other arguments
-from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)"
-  (if (memq '&key arglist) (error "&key not allowed in define-modify-macro"))
-  (let ((place (gensym "--place--")))
-    (list 'defmacro* name (cons place arglist) doc
-	  (list* (if (memq '&rest arglist) 'list* 'list)
-		 '(quote callf) (list 'quote func) place
-		 (cl-arglist-args arglist)))))
-
-
-;;; Structures.
-
-(defmacro defstruct (struct &rest descs)
-  "(defstruct (NAME OPTIONS...) (SLOT SLOT-OPTS...)...): define a struct type.
-This macro defines a new Lisp data type called NAME, which contains data
-stored in SLOTs.  This defines a `make-NAME' constructor, a `copy-NAME'
-copier, a `NAME-p' predicate, and setf-able `NAME-SLOT' accessors."
-  (let* ((name (if (consp struct) (car struct) struct))
-	 (opts (cdr-safe struct))
-	 (slots nil)
-	 (defaults nil)
-	 (conc-name (concat (symbol-name name) "-"))
-	 (constructor (intern (format "make-%s" name)))
-	 (constrs nil)
-	 (copier (intern (format "copy-%s" name)))
-	 (predicate (intern (format "%s-p" name)))
-	 (print-func nil) (print-auto nil)
-	 (safety (if (cl-compiling-file) cl-optimize-safety 3))
-	 (include nil)
-	 (tag (intern (format "cl-struct-%s" name)))
-	 (tag-symbol (intern (format "cl-struct-%s-tags" name)))
-	 (include-descs nil)
-	 (side-eff nil)
-	 (type nil)
-	 (named nil)
-	 (forms nil)
-	 pred-form pred-check)
-    (if (stringp (car descs))
-	(cl-push (list 'put (list 'quote name) '(quote structure-documentation)
-		       (cl-pop descs)) forms))
-    (setq descs (cons '(cl-tag-slot)
-		      (mapcar (function (lambda (x) (if (consp x) x (list x))))
-			      descs)))
-    (while opts
-      (let ((opt (if (consp (car opts)) (caar opts) (car opts)))
-	    (args (cdr-safe (cl-pop opts))))
-	(cond ((eq opt ':conc-name)
-	       (if args
-		   (setq conc-name (if (car args)
-				       (symbol-name (car args)) ""))))
-	      ((eq opt ':constructor)
-	       (if (cdr args)
-		   (cl-push args constrs)
-		 (if args (setq constructor (car args)))))
-	      ((eq opt ':copier)
-	       (if args (setq copier (car args))))
-	      ((eq opt ':predicate)
-	       (if args (setq predicate (car args))))
-	      ((eq opt ':include)
-	       (setq include (car args)
-		     include-descs (mapcar (function
-					    (lambda (x)
-					      (if (consp x) x (list x))))
-					   (cdr args))))
-	      ((eq opt ':print-function)
-	       (setq print-func (car args)))
-	      ((eq opt ':type)
-	       (setq type (car args)))
-	      ((eq opt ':named)
-	       (setq named t))
-	      ((eq opt ':initial-offset)
-	       (setq descs (nconc (make-list (car args) '(cl-skip-slot))
-				  descs)))
-	      (t
-	       (error "Slot option %s unrecognized" opt)))))
-    (if print-func
-	(setq print-func (list 'progn
-			       (list 'funcall (list 'function print-func)
-				     'cl-x 'cl-s 'cl-n) t))
-      (or type (and include (not (get include 'cl-struct-print)))
-	  (setq print-auto t
-		print-func (and (or (not (or include type)) (null print-func))
-				(list 'progn
-				      (list 'princ (format "#S(%s" name)
-					    'cl-s))))))
-    (if include
-	(let ((inc-type (get include 'cl-struct-type))
-	      (old-descs (get include 'cl-struct-slots)))
-	  (or inc-type (error "%s is not a struct name" include))
-	  (and type (not (eq (car inc-type) type))
-	       (error ":type disagrees with :include for %s" name))
-	  (while include-descs
-	    (setcar (memq (or (assq (caar include-descs) old-descs)
-			      (error "No slot %s in included struct %s"
-				     (caar include-descs) include))
-			  old-descs)
-		    (cl-pop include-descs)))
-	  (setq descs (append old-descs (delq (assq 'cl-tag-slot descs) descs))
-		type (car inc-type)
-		named (assq 'cl-tag-slot descs))
-	  (if (cadr inc-type) (setq tag name named t))
-	  (let ((incl include))
-	    (while incl
-	      (cl-push (list 'pushnew (list 'quote tag)
-			     (intern (format "cl-struct-%s-tags" incl)))
-		       forms)
-	      (setq incl (get incl 'cl-struct-include)))))
-      (if type
-	  (progn
-	    (or (memq type '(vector list))
-		(error "Illegal :type specifier: %s" type))
-	    (if named (setq tag name)))
-	(setq type 'vector named 'true)))
-    (or named (setq descs (delq (assq 'cl-tag-slot descs) descs)))
-    (cl-push (list 'defvar tag-symbol) forms)
-    (setq pred-form (and named
-			 (let ((pos (- (length descs)
-				       (length (memq (assq 'cl-tag-slot descs)
-						     descs)))))
-			   (if (eq type 'vector)
-			       (list 'and '(vectorp cl-x)
-				     (list '>= '(length cl-x) (length descs))
-				     (list 'memq (list 'aref 'cl-x pos)
-					   tag-symbol))
-			     (if (= pos 0)
-				 (list 'memq '(car-safe cl-x) tag-symbol)
-			       (list 'and '(consp cl-x)
-				     (list 'memq (list 'nth pos 'cl-x)
-					   tag-symbol))))))
-	  pred-check (and pred-form (> safety 0)
-			  (if (and (eq (caadr pred-form) 'vectorp)
-				   (= safety 1))
-			      (cons 'and (cdddr pred-form)) pred-form)))
-    (let ((pos 0) (descp descs))
-      (while descp
-	(let* ((desc (cl-pop descp))
-	       (slot (car desc)))
-	  (if (memq slot '(cl-tag-slot cl-skip-slot))
-	      (progn
-		(cl-push nil slots)
-		(cl-push (and (eq slot 'cl-tag-slot) (list 'quote tag))
-			 defaults))
-	    (if (assq slot descp)
-		(error "Duplicate slots named %s in %s" slot name))
-	    (let ((accessor (intern (format "%s%s" conc-name slot))))
-	      (cl-push slot slots)
-	      (cl-push (nth 1 desc) defaults)
-	      (cl-push (list*
-			'defsubst* accessor '(cl-x)
-			(append
-			 (and pred-check
-			      (list (list 'or pred-check
-					  (list 'error
-						(format "%s accessing a non-%s"
-							accessor name)
-						'cl-x))))
-			 (list (if (eq type 'vector) (list 'aref 'cl-x pos)
-				 (if (= pos 0) '(car cl-x)
-				   (list 'nth pos 'cl-x)))))) forms)
-	      (cl-push (cons accessor t) side-eff)
-	      (cl-push (list 'define-setf-method accessor '(cl-x)
-			     (if (cadr (memq ':read-only (cddr desc)))
-				 (list 'error (format "%s is a read-only slot"
-						      accessor))
-			       (list 'cl-struct-setf-expander 'cl-x
-				     (list 'quote name) (list 'quote accessor)
-				     (and pred-check (list 'quote pred-check))
-				     pos)))
-		       forms)
-	      (if print-auto
-		  (nconc print-func
-			 (list (list 'princ (format " %s" slot) 'cl-s)
-			       (list 'prin1 (list accessor 'cl-x) 'cl-s)))))))
-	(setq pos (1+ pos))))
-    (setq slots (nreverse slots)
-	  defaults (nreverse defaults))
-    (and predicate pred-form
-	 (progn (cl-push (list 'defsubst* predicate '(cl-x)
-			       (if (eq (car pred-form) 'and)
-				   (append pred-form '(t))
-				 (list 'and pred-form t))) forms)
-		(cl-push (cons predicate 'error-free) side-eff)))
-    (and copier
-	 (progn (cl-push (list 'defun copier '(x) '(copy-sequence x)) forms)
-		(cl-push (cons copier t) side-eff)))
-    (if constructor
-	(cl-push (list constructor
-		       (cons '&key (delq nil (copy-sequence slots))))
-		 constrs))
-    (while constrs
-      (let* ((name (caar constrs))
-	     (args (cadr (cl-pop constrs)))
-	     (anames (cl-arglist-args args))
-	     (make (mapcar* (function (lambda (s d) (if (memq s anames) s d)))
-			    slots defaults)))
-	(cl-push (list 'defsubst* name
-		       (list* '&cl-defs (list 'quote (cons nil descs)) args)
-		       (cons type make)) forms)
-	(if (cl-safe-expr-p (cons 'progn (mapcar 'second descs)))
-	    (cl-push (cons name t) side-eff))))
-    (if print-auto (nconc print-func (list '(princ ")" cl-s) t)))
-    (if print-func
-	(cl-push (list 'push
-		       (list 'function
-			     (list 'lambda '(cl-x cl-s cl-n)
-				   (list 'and pred-form print-func)))
-		       'custom-print-functions) forms))
-    (cl-push (list 'setq tag-symbol (list 'list (list 'quote tag))) forms)
-    (cl-push (list* 'eval-when '(compile load eval)
-		    (list 'put (list 'quote name) '(quote cl-struct-slots)
-			  (list 'quote descs))
-		    (list 'put (list 'quote name) '(quote cl-struct-type)
-			  (list 'quote (list type (eq named t))))
-		    (list 'put (list 'quote name) '(quote cl-struct-include)
-			  (list 'quote include))
-		    (list 'put (list 'quote name) '(quote cl-struct-print)
-			  print-auto)
-		    (mapcar (function (lambda (x)
-					(list 'put (list 'quote (car x))
-					      '(quote side-effect-free)
-					      (list 'quote (cdr x)))))
-			    side-eff))
-	     forms)
-    (cons 'progn (nreverse (cons (list 'quote name) forms)))))
-
-(defun cl-struct-setf-expander (x name accessor pred-form pos)
-  (let* ((temp (gensym "--x--")) (store (gensym "--store--")))
-    (list (list temp) (list x) (list store)
-	  (append '(progn)
-		  (and pred-form
-		       (list (list 'or (subst temp 'cl-x pred-form)
-				   (list 'error
-					 (format
-					  "%s storing a non-%s" accessor name)
-					 temp))))
-		  (list (if (eq (car (get name 'cl-struct-type)) 'vector)
-			    (list 'aset temp pos store)
-			  (list 'setcar
-				(if (<= pos 5)
-				    (let ((xx temp))
-				      (while (>= (setq pos (1- pos)) 0)
-					(setq xx (list 'cdr xx)))
-				      xx)
-				  (list 'nthcdr pos temp))
-				store))))
-	  (list accessor temp))))
-
-
-;;; Types and assertions.
-
-(defmacro deftype (name args &rest body)
-  "(deftype NAME ARGLIST BODY...): define NAME as a new data type.
-The type name can then be used in `typecase', `check-type', etc."
-  (list 'eval-when '(compile load eval)
-	(cl-transform-function-property
-	 name 'cl-deftype-handler (cons (list* '&cl-defs ''('*) args) body))))
-
-(defun cl-make-type-test (val type)
-  (if (memq type '(character string-char)) (setq type '(integer 0 255)))
-  (if (symbolp type)
-      (cond ((get type 'cl-deftype-handler)
-	     (cl-make-type-test val (funcall (get type 'cl-deftype-handler))))
-	    ((memq type '(nil t)) type)
-	    ((eq type 'null) (list 'null val))
-	    ((eq type 'float) (list 'floatp-safe val))
-	    ((eq type 'real) (list 'numberp val))
-	    ((eq type 'fixnum) (list 'integerp val))
-	    (t
-	     (let* ((name (symbol-name type))
-		    (namep (intern (concat name "p"))))
-	       (if (fboundp namep) (list namep val)
-		 (list (intern (concat name "-p")) val)))))
-    (cond ((get (car type) 'cl-deftype-handler)
-	   (cl-make-type-test val (apply (get (car type) 'cl-deftype-handler)
-					 (cdr type))))
-	  ((memq (car-safe type) '(integer float real number))
-	   (delq t (list 'and (cl-make-type-test val (car type))
-			 (if (memq (cadr type) '(* nil)) t
-			   (if (consp (cadr type)) (list '> val (caadr type))
-			     (list '>= val (cadr type))))
-			 (if (memq (caddr type) '(* nil)) t
-			   (if (consp (caddr type)) (list '< val (caaddr type))
-			     (list '<= val (caddr type)))))))
-	  ((memq (car-safe type) '(and or not))
-	   (cons (car type)
-		 (mapcar (function (lambda (x) (cl-make-type-test val x)))
-			 (cdr type))))
-	  ((memq (car-safe type) '(member member*))
-	   (list 'and (list 'member* val (list 'quote (cdr type))) t))
-	  ((eq (car-safe type) 'satisfies) (list (cadr type) val))
-	  (t (error "Bad type spec: %s" type)))))
-
-(defun typep (val type)   ; See compiler macro below.
-  "Check that OBJECT is of type TYPE.
-TYPE is a Common Lisp-style type specifier."
-  (eval (cl-make-type-test 'val type)))
-
-(defmacro check-type (form type &optional string)
-  "Verify that FORM is of type TYPE; signal an error if not.
-STRING is an optional description of the desired type."
-  (and (or (not (cl-compiling-file))
-	   (< cl-optimize-speed 3) (= cl-optimize-safety 3))
-       (let* ((temp (if (cl-simple-expr-p form 3) form (gensym)))
-	      (body (list 'or (cl-make-type-test temp type)
-			  (list 'signal '(quote wrong-type-argument)
-				(list 'list (or string (list 'quote type))
-				      temp (list 'quote form))))))
-	 (if (eq temp form) (list 'progn body nil)
-	   (list 'let (list (list temp form)) body nil)))))
-
-(defmacro assert (form &optional show-args string &rest args)
-  "Verify that FORM returns non-nil; signal an error if not.
-Second arg SHOW-ARGS means to include arguments of FORM in message.
-Other args STRING and ARGS... are arguments to be passed to `error'.
-They are not evaluated unless the assertion fails.  If STRING is
-omitted, a default message listing FORM itself is used."
-  (and (or (not (cl-compiling-file))
-	   (< cl-optimize-speed 3) (= cl-optimize-safety 3))
-       (let ((sargs (and show-args (delq nil (mapcar
-					      (function
-					       (lambda (x)
-						 (and (not (cl-const-expr-p x))
-						      x))) (cdr form))))))
-	 (list 'progn
-	       (list 'or form
-		     (if string
-			 (list* 'error string (append sargs args))
-		       (list 'signal '(quote cl-assertion-failed)
-			     (list* 'list (list 'quote form) sargs))))
-	       nil))))
-
-(defmacro ignore-errors (&rest body)
-  "Execute FORMS; if an error occurs, return nil.
-Otherwise, return result of last FORM."
-  (let ((err (gensym)))
-    (list 'condition-case err (cons 'progn body) '(error nil))))
-
-
-;;; Some predicates for analyzing Lisp forms.  These are used by various
-;;; macro expanders to optimize the results in certain common cases.
-
-(defconst cl-simple-funcs '(car cdr nth aref elt if and or + - 1+ 1- min max
-			    car-safe cdr-safe progn prog1 prog2))
-(defconst cl-safe-funcs '(* / % length memq list vector vectorp
-			  < > <= >= = error))
-
-;;; Check if no side effects, and executes quickly.
-(defun cl-simple-expr-p (x &optional size)
-  (or size (setq size 10))
-  (if (and (consp x) (not (memq (car x) '(quote function function*))))
-      (and (symbolp (car x))
-	   (or (memq (car x) cl-simple-funcs)
-	       (get (car x) 'side-effect-free))
-	   (progn
-	     (setq size (1- size))
-	     (while (and (setq x (cdr x))
-			 (setq size (cl-simple-expr-p (car x) size))))
-	     (and (null x) (>= size 0) size)))
-    (and (> size 0) (1- size))))
-
-(defun cl-simple-exprs-p (xs)
-  (while (and xs (cl-simple-expr-p (car xs)))
-    (setq xs (cdr xs)))
-  (not xs))
-
-;;; Check if no side effects.
-(defun cl-safe-expr-p (x)
-  (or (not (and (consp x) (not (memq (car x) '(quote function function*)))))
-      (and (symbolp (car x))
-	   (or (memq (car x) cl-simple-funcs)
-	       (memq (car x) cl-safe-funcs)
-	       (get (car x) 'side-effect-free))
-	   (progn
-	     (while (and (setq x (cdr x)) (cl-safe-expr-p (car x))))
-	     (null x)))))
-
-;;; Check if constant (i.e., no side effects or dependencies).
-(defun cl-const-expr-p (x)
-  (cond ((consp x)
-	 (or (eq (car x) 'quote)
-	     (and (memq (car x) '(function function*))
-		  (or (symbolp (nth 1 x))
-		      (and (eq (car-safe (nth 1 x)) 'lambda) 'func)))))
-	((symbolp x) (and (memq x '(nil t)) t))
-	(t t)))
-
-(defun cl-const-exprs-p (xs)
-  (while (and xs (cl-const-expr-p (car xs)))
-    (setq xs (cdr xs)))
-  (not xs))
-
-(defun cl-const-expr-val (x)
-  (and (eq (cl-const-expr-p x) t) (if (consp x) (nth 1 x) x)))
-
-(defun cl-expr-access-order (x v)
-  (if (cl-const-expr-p x) v
-    (if (consp x)
-	(progn
-	  (while (setq x (cdr x)) (setq v (cl-expr-access-order (car x) v)))
-	  v)
-      (if (eq x (car v)) (cdr v) '(t)))))
-
-;;; Count number of times X refers to Y.  Return NIL for 0 times.
-(defun cl-expr-contains (x y)
-  (cond ((equal y x) 1)
-	((and (consp x) (not (memq (car-safe x) '(quote function function*))))
-	 (let ((sum 0))
-	   (while x
-	     (setq sum (+ sum (or (cl-expr-contains (cl-pop x) y) 0))))
-	   (and (> sum 0) sum)))
-	(t nil)))
-
-(defun cl-expr-contains-any (x y)
-  (while (and y (not (cl-expr-contains x (car y)))) (cl-pop y))
-  y)
-
-;;; Check whether X may depend on any of the symbols in Y.
-(defun cl-expr-depends-p (x y)
-  (and (not (cl-const-expr-p x))
-       (or (not (cl-safe-expr-p x)) (cl-expr-contains-any x y))))
-
-
-;;; Compiler macros.
-
-(defmacro define-compiler-macro (func args &rest body)
-  "(define-compiler-macro FUNC ARGLIST BODY...): Define a compiler-only macro.
-This is like `defmacro', but macro expansion occurs only if the call to
-FUNC is compiled (i.e., not interpreted).  Compiler macros should be used
-for optimizing the way calls to FUNC are compiled; the form returned by
-BODY should do the same thing as a call to the normal function called
-FUNC, though possibly more efficiently.  Note that, like regular macros,
-compiler macros are expanded repeatedly until no further expansions are
-possible.  Unlike regular macros, BODY can decide to \"punt\" and leave the
-original function call alone by declaring an initial `&whole foo' parameter
-and then returning foo."
-  (let ((p (if (listp args) args (list '&rest args))) (res nil))
-    (while (consp p) (cl-push (cl-pop p) res))
-    (setq args (nreverse res)) (setcdr res (and p (list '&rest p))))
-  (list 'eval-when '(compile load eval)
-	(cl-transform-function-property
-	 func 'cl-compiler-macro
-	 (cons (if (memq '&whole args) (delq '&whole args)
-		 (cons '--cl-whole-arg-- args)) body))
-	(list 'or (list 'get (list 'quote func) '(quote byte-compile))
-	      (list 'put (list 'quote func) '(quote byte-compile)
-		    '(quote cl-byte-compile-compiler-macro)))))
-
-(defun compiler-macroexpand (form)
-  (while
-      (let ((func (car-safe form)) (handler nil))
-	(while (and (symbolp func)
-		    (not (setq handler (get func 'cl-compiler-macro)))
-		    (fboundp func)
-		    (or (not (eq (car-safe (symbol-function func)) 'autoload))
-			(load (nth 1 (symbol-function func)))))
-	  (setq func (symbol-function func)))
-	(and handler
-	     (not (eq form (setq form (apply handler form (cdr form))))))))
-  form)
-
-(defun cl-byte-compile-compiler-macro (form)
-  (if (eq form (setq form (compiler-macroexpand form)))
-      (byte-compile-normal-call form)
-    (byte-compile-form form)))
-
-(defmacro defsubst* (name args &rest body)
-  "(defsubst* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function.
-Like `defun', except the function is automatically declared `inline',
-ARGLIST allows full Common Lisp conventions, and BODY is implicitly
-surrounded by (block NAME ...)."
-  (let* ((argns (cl-arglist-args args)) (p argns)
-	 (pbody (cons 'progn body))
-	 (unsafe (not (cl-safe-expr-p pbody))))
-    (while (and p (eq (cl-expr-contains args (car p)) 1)) (cl-pop p))
-    (list 'progn
-	  (if p nil   ; give up if defaults refer to earlier args
-	    (list 'define-compiler-macro name
-		  (list* '&whole 'cl-whole '&cl-quote args)
-		  (list* 'cl-defsubst-expand (list 'quote argns)
-			 (list 'quote (list* 'block name body))
-			 (not (or unsafe (cl-expr-access-order pbody argns)))
-			 (and (memq '&key args) 'cl-whole) unsafe argns)))
-	  (list* 'defun* name args body))))
-
-(defun cl-defsubst-expand (argns body simple whole unsafe &rest argvs)
-  (if (and whole (not (cl-safe-expr-p (cons 'progn argvs)))) whole
-    (if (cl-simple-exprs-p argvs) (setq simple t))
-    (let ((lets (delq nil
-		      (mapcar* (function
-				(lambda (argn argv)
-				  (if (or simple (cl-const-expr-p argv))
-				      (progn (setq body (subst argv argn body))
-					     (and unsafe (list argn argv)))
-				    (list argn argv))))
-			       argns argvs))))
-      (if lets (list 'let lets body) body))))
-
-
-;;; Compile-time optimizations for some functions defined in this package.
-;;; Note that cl.el arranges to force cl-macs to be loaded at compile-time,
-;;; mainly to make sure these macros will be present.
-
-(put 'eql 'byte-compile nil)
-(define-compiler-macro eql (&whole form a b)
-  (cond ((eq (cl-const-expr-p a) t)
-	 (let ((val (cl-const-expr-val a)))
-	   (if (and (numberp val) (not (integerp val)))
-	       (list 'equal a b)
-	     (list 'eq a b))))
-	((eq (cl-const-expr-p b) t)
-	 (let ((val (cl-const-expr-val b)))
-	   (if (and (numberp val) (not (integerp val)))
-	       (list 'equal a b)
-	     (list 'eq a b))))
-	((cl-simple-expr-p a 5)
-	 (list 'if (list 'numberp a)
-	       (list 'equal a b)
-	       (list 'eq a b)))
-	((and (cl-safe-expr-p a)
-	      (cl-simple-expr-p b 5))
-	 (list 'if (list 'numberp b)
-	       (list 'equal a b)
-	       (list 'eq a b)))
-	(t form)))
-
-(define-compiler-macro member* (&whole form a list &rest keys)
-  (let ((test (and (= (length keys) 2) (eq (car keys) ':test)
-		   (cl-const-expr-val (nth 1 keys)))))
-    (cond ((eq test 'eq) (list 'memq a list))
-	  ((eq test 'equal) (list 'member a list))
-	  ((or (null keys) (eq test 'eql))
-	   (if (eq (cl-const-expr-p a) t)
-	       (list (if (floatp-safe (cl-const-expr-val a)) 'member 'memq)
-		     a list)
-	     (if (eq (cl-const-expr-p list) t)
-		 (let ((p (cl-const-expr-val list)) (mb nil) (mq nil))
-		   (if (not (cdr p))
-		       (and p (list 'eql a (list 'quote (car p))))
-		     (while p
-		       (if (floatp-safe (car p)) (setq mb t)
-			 (or (integerp (car p)) (symbolp (car p)) (setq mq t)))
-		       (setq p (cdr p)))
-		     (if (not mb) (list 'memq a list)
-		       (if (not mq) (list 'member a list) form))))
-	       form)))
-	  (t form))))
-
-(define-compiler-macro assoc* (&whole form a list &rest keys)
-  (let ((test (and (= (length keys) 2) (eq (car keys) ':test)
-		   (cl-const-expr-val (nth 1 keys)))))
-    (cond ((eq test 'eq) (list 'assq a list))
-	  ((eq test 'equal) (list 'assoc a list))
-	  ((and (eq (cl-const-expr-p a) t) (or (null keys) (eq test 'eql)))
-	   (if (floatp-safe (cl-const-expr-val a))
-	       (list 'assoc a list) (list 'assq a list)))
-	  (t form))))
-
-(define-compiler-macro adjoin (&whole form a list &rest keys)
-  (if (and (cl-simple-expr-p a) (cl-simple-expr-p list)
-	   (not (memq ':key keys)))
-      (list 'if (list* 'member* a list keys) list (list 'cons a list))
-    form))
-
-(define-compiler-macro list* (arg &rest others)
-  (let* ((args (reverse (cons arg others)))
-	 (form (car args)))
-    (while (setq args (cdr args))
-      (setq form (list 'cons (car args) form)))
-    form))
-
-(define-compiler-macro get* (sym prop &optional def)
-  (if def
-      (list 'getf (list 'symbol-plist sym) prop def)
-    (list 'get sym prop)))
-
-(define-compiler-macro typep (&whole form val type)
-  (if (cl-const-expr-p type)
-      (let ((res (cl-make-type-test val (cl-const-expr-val type))))
-	(if (or (memq (cl-expr-contains res val) '(nil 1))
-		(cl-simple-expr-p val)) res
-	  (let ((temp (gensym)))
-	    (list 'let (list (list temp val)) (subst temp val res)))))
-    form))
-
-
-(mapcar (function
-	 (lambda (y)
-	   (put (car y) 'side-effect-free t)
-	   (put (car y) 'byte-compile 'cl-byte-compile-compiler-macro)
-	   (put (car y) 'cl-compiler-macro
-		(list 'lambda '(w x)
-		      (if (symbolp (cadr y))
-			  (list 'list (list 'quote (cadr y))
-				(list 'list (list 'quote (caddr y)) 'x))
-			(cons 'list (cdr y)))))))
-	'((first 'car x) (second 'cadr x) (third 'caddr x) (fourth 'cadddr x)
-	  (fifth 'nth 4 x) (sixth 'nth 5 x) (seventh 'nth 6 x)
-	  (eighth 'nth 7 x) (ninth 'nth 8 x) (tenth 'nth 9 x)
-	  (rest 'cdr x) (endp 'null x) (plusp '> x 0) (minusp '< x 0)
-	  (caar car car) (cadr car cdr) (cdar cdr car) (cddr cdr cdr)
-	  (caaar car caar) (caadr car cadr) (cadar car cdar)
-	  (caddr car cddr) (cdaar cdr caar) (cdadr cdr cadr)
-	  (cddar cdr cdar) (cdddr cdr cddr) (caaaar car caaar)
-	  (caaadr car caadr) (caadar car cadar) (caaddr car caddr)
-	  (cadaar car cdaar) (cadadr car cdadr) (caddar car cddar)
-	  (cadddr car cdddr) (cdaaar cdr caaar) (cdaadr cdr caadr)
-	  (cdadar cdr cadar) (cdaddr cdr caddr) (cddaar cdr cdaar)
-	  (cddadr cdr cdadr) (cdddar cdr cddar) (cddddr cdr cdddr) ))
-
-;;; Things that are inline.
-(proclaim '(inline floatp-safe acons map concatenate notany notevery
-		   cl-set-elt revappend nreconc gethash))
-
-;;; Things that are side-effect-free.
-(mapcar (function (lambda (x) (put x 'side-effect-free t)))
-	'(oddp evenp abs expt signum last butlast ldiff pairlis gcd lcm
-	  isqrt floor* ceiling* truncate* round* mod* rem* subseq
-	  list-length get* getf gethash hash-table-count))
-
-;;; Things that are side-effect-and-error-free.
-(mapcar (function (lambda (x) (put x 'side-effect-free 'error-free)))
-	'(eql floatp-safe list* subst acons equalp random-state-p
-	  copy-tree sublis hash-table-p))
-
-
-(run-hooks 'cl-macs-load-hook)
-
-;;; cl-macs.el ends here
diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el
deleted file mode 100644
index eaac88a4e22..00000000000
--- a/lisp/emacs-lisp/cl-seq.el
+++ /dev/null
@@ -1,919 +0,0 @@
-;;; cl-seq.el --- Common Lisp features, part 3  -*-byte-compile-dynamic: t;-*-
-
-;; Copyright (C) 1993 Free Software Foundation, Inc.
-
-;; Author: Dave Gillespie <daveg@synaptics.com>
-;; Version: 2.02
-;; Keywords: extensions
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; These are extensions to Emacs Lisp that provide a degree of
-;; Common Lisp compatibility, beyond what is already built-in
-;; in Emacs Lisp.
-;;
-;; This package was written by Dave Gillespie; it is a complete
-;; rewrite of Cesar Quiroz's original cl.el package of December 1986.
-;;
-;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19.
-;;
-;; Bug reports, comments, and suggestions are welcome!
-
-;; This file contains the Common Lisp sequence and list functions
-;; which take keyword arguments.
-
-;; See cl.el for Change Log.
-
-
-;;; Code:
-
-(or (memq 'cl-19 features)
-    (error "Tried to load `cl-seq' before `cl'!"))
-
-
-;;; We define these here so that this file can compile without having
-;;; loaded the cl.el file already.
-
-(defmacro cl-push (x place) (list 'setq place (list 'cons x place)))
-(defmacro cl-pop (place)
-  (list 'car (list 'prog1 place (list 'setq place (list 'cdr place)))))
-
-
-;;; Keyword parsing.  This is special-cased here so that we can compile
-;;; this file independent from cl-macs.
-
-(defmacro cl-parsing-keywords (kwords other-keys &rest body)
-  (cons
-   'let*
-   (cons (mapcar
-	  (function
-	   (lambda (x)
-	     (let* ((var (if (consp x) (car x) x))
-		    (mem (list 'car (list 'cdr (list 'memq (list 'quote var)
-						     'cl-keys)))))
-	       (if (eq var ':test-not)
-		   (setq mem (list 'and mem (list 'setq 'cl-test mem) t)))
-	       (if (eq var ':if-not)
-		   (setq mem (list 'and mem (list 'setq 'cl-if mem) t)))
-	       (list (intern
-		      (format "cl-%s" (substring (symbol-name var) 1)))
-		     (if (consp x) (list 'or mem (car (cdr x))) mem)))))
-	  kwords)
-	 (append
-	  (and (not (eq other-keys t))
-	       (list
-		(list 'let '((cl-keys-temp cl-keys))
-		      (list 'while 'cl-keys-temp
-			    (list 'or (list 'memq '(car cl-keys-temp)
-					    (list 'quote
-						  (mapcar
-						   (function
-						    (lambda (x)
-						      (if (consp x)
-							  (car x) x)))
-						   (append kwords
-							   other-keys))))
-				  '(car (cdr (memq (quote :allow-other-keys)
-						   cl-keys)))
-				  '(error "Bad keyword argument %s"
-					  (car cl-keys-temp)))
-			    '(setq cl-keys-temp (cdr (cdr cl-keys-temp)))))))
-	  body))))
-(put 'cl-parsing-keywords 'lisp-indent-function 2)
-(put 'cl-parsing-keywords 'edebug-form-spec '(sexp sexp &rest form))
-
-(defmacro cl-check-key (x)
-  (list 'if 'cl-key (list 'funcall 'cl-key x) x))
-
-(defmacro cl-check-test-nokey (item x)
-  (list 'cond
-	(list 'cl-test
-	      (list 'eq (list 'not (list 'funcall 'cl-test item x))
-		    'cl-test-not))
-	(list 'cl-if
-	      (list 'eq (list 'not (list 'funcall 'cl-if x)) 'cl-if-not))
-	(list 't (list 'if (list 'numberp item)
-		       (list 'equal item x) (list 'eq item x)))))
-
-(defmacro cl-check-test (item x)
-  (list 'cl-check-test-nokey item (list 'cl-check-key x)))
-
-(defmacro cl-check-match (x y)
-  (setq x (list 'cl-check-key x) y (list 'cl-check-key y))
-  (list 'if 'cl-test
-	(list 'eq (list 'not (list 'funcall 'cl-test x y)) 'cl-test-not)
-	(list 'if (list 'numberp x)
-	      (list 'equal x y) (list 'eq x y))))
-
-(put 'cl-check-key 'edebug-form-spec 'edebug-forms)
-(put 'cl-check-test 'edebug-form-spec 'edebug-forms)
-(put 'cl-check-test-nokey 'edebug-form-spec 'edebug-forms)
-(put 'cl-check-match 'edebug-form-spec 'edebug-forms)
-
-(defvar cl-test) (defvar cl-test-not)
-(defvar cl-if) (defvar cl-if-not)
-(defvar cl-key)
-
-
-(defun reduce (cl-func cl-seq &rest cl-keys)
-  "Reduce two-argument FUNCTION across SEQUENCE.
-Keywords supported:  :start :end :from-end :initial-value :key"
-  (cl-parsing-keywords (:from-end (:start 0) :end :initial-value :key) ()
-    (or (listp cl-seq) (setq cl-seq (append cl-seq nil)))
-    (setq cl-seq (subseq cl-seq cl-start cl-end))
-    (if cl-from-end (setq cl-seq (nreverse cl-seq)))
-    (let ((cl-accum (cond ((memq ':initial-value cl-keys) cl-initial-value)
-			  (cl-seq (cl-check-key (cl-pop cl-seq)))
-			  (t (funcall cl-func)))))
-      (if cl-from-end
-	  (while cl-seq
-	    (setq cl-accum (funcall cl-func (cl-check-key (cl-pop cl-seq))
-				    cl-accum)))
-	(while cl-seq
-	  (setq cl-accum (funcall cl-func cl-accum
-				  (cl-check-key (cl-pop cl-seq))))))
-      cl-accum)))
-
-(defun fill (seq item &rest cl-keys)
-  "Fill the elements of SEQ with ITEM.
-Keywords supported:  :start :end"
-  (cl-parsing-keywords ((:start 0) :end) ()
-    (if (listp seq)
-	(let ((p (nthcdr cl-start seq))
-	      (n (if cl-end (- cl-end cl-start) 8000000)))
-	  (while (and p (>= (setq n (1- n)) 0))
-	    (setcar p item)
-	    (setq p (cdr p))))
-      (or cl-end (setq cl-end (length seq)))
-      (if (and (= cl-start 0) (= cl-end (length seq)))
-	  (fillarray seq item)
-	(while (< cl-start cl-end)
-	  (aset seq cl-start item)
-	  (setq cl-start (1+ cl-start)))))
-    seq))
-
-(defun replace (cl-seq1 cl-seq2 &rest cl-keys)
-  "Replace the elements of SEQ1 with the elements of SEQ2.
-SEQ1 is destructively modified, then returned.
-Keywords supported:  :start1 :end1 :start2 :end2"
-  (cl-parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) ()
-    (if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1))
-	(or (= cl-start1 cl-start2)
-	    (let* ((cl-len (length cl-seq1))
-		   (cl-n (min (- (or cl-end1 cl-len) cl-start1)
-			      (- (or cl-end2 cl-len) cl-start2))))
-	      (while (>= (setq cl-n (1- cl-n)) 0)
-		(cl-set-elt cl-seq1 (+ cl-start1 cl-n)
-			    (elt cl-seq2 (+ cl-start2 cl-n))))))
-      (if (listp cl-seq1)
-	  (let ((cl-p1 (nthcdr cl-start1 cl-seq1))
-		(cl-n1 (if cl-end1 (- cl-end1 cl-start1) 4000000)))
-	    (if (listp cl-seq2)
-		(let ((cl-p2 (nthcdr cl-start2 cl-seq2))
-		      (cl-n (min cl-n1
-				 (if cl-end2 (- cl-end2 cl-start2) 4000000))))
-		  (while (and cl-p1 cl-p2 (>= (setq cl-n (1- cl-n)) 0))
-		    (setcar cl-p1 (car cl-p2))
-		    (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2))))
-	      (setq cl-end2 (min (or cl-end2 (length cl-seq2))
-				 (+ cl-start2 cl-n1)))
-	      (while (and cl-p1 (< cl-start2 cl-end2))
-		(setcar cl-p1 (aref cl-seq2 cl-start2))
-		(setq cl-p1 (cdr cl-p1) cl-start2 (1+ cl-start2)))))
-	(setq cl-end1 (min (or cl-end1 (length cl-seq1))
-			   (+ cl-start1 (- (or cl-end2 (length cl-seq2))
-					   cl-start2))))
-	(if (listp cl-seq2)
-	    (let ((cl-p2 (nthcdr cl-start2 cl-seq2)))
-	      (while (< cl-start1 cl-end1)
-		(aset cl-seq1 cl-start1 (car cl-p2))
-		(setq cl-p2 (cdr cl-p2) cl-start1 (1+ cl-start1))))
-	  (while (< cl-start1 cl-end1)
-	    (aset cl-seq1 cl-start1 (aref cl-seq2 cl-start2))
-	    (setq cl-start2 (1+ cl-start2) cl-start1 (1+ cl-start1))))))
-    cl-seq1))
-
-(defun remove* (cl-item cl-seq &rest cl-keys)
-  "Remove all occurrences of ITEM in SEQ.
-This is a non-destructive function; it makes a copy of SEQ if necessary
-to avoid corrupting the original SEQ.
-Keywords supported:  :test :test-not :key :count :start :end :from-end"
-  (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end
-			(:start 0) :end) ()
-    (if (<= (or cl-count (setq cl-count 8000000)) 0)
-	cl-seq
-      (if (or (nlistp cl-seq) (and cl-from-end (< cl-count 4000000)))
-	  (let ((cl-i (cl-position cl-item cl-seq cl-start cl-end
-				   cl-from-end)))
-	    (if cl-i
-		(let ((cl-res (apply 'delete* cl-item (append cl-seq nil)
-				     (append (if cl-from-end
-						 (list ':end (1+ cl-i))
-					       (list ':start cl-i))
-					     cl-keys))))
-		  (if (listp cl-seq) cl-res
-		    (if (stringp cl-seq) (concat cl-res) (vconcat cl-res))))
-	      cl-seq))
-	(setq cl-end (- (or cl-end 8000000) cl-start))
-	(if (= cl-start 0)
-	    (while (and cl-seq (> cl-end 0)
-			(cl-check-test cl-item (car cl-seq))
-			(setq cl-end (1- cl-end) cl-seq (cdr cl-seq))
-			(> (setq cl-count (1- cl-count)) 0))))
-	(if (and (> cl-count 0) (> cl-end 0))
-	    (let ((cl-p (if (> cl-start 0) (nthcdr cl-start cl-seq)
-			  (setq cl-end (1- cl-end)) (cdr cl-seq))))
-	      (while (and cl-p (> cl-end 0)
-			  (not (cl-check-test cl-item (car cl-p))))
-		(setq cl-p (cdr cl-p) cl-end (1- cl-end)))
-	      (if (and cl-p (> cl-end 0))
-		  (nconc (ldiff cl-seq cl-p)
-			 (if (= cl-count 1) (cdr cl-p)
-			   (and (cdr cl-p)
-				(apply 'delete* cl-item
-				       (copy-sequence (cdr cl-p))
-				       ':start 0 ':end (1- cl-end)
-				       ':count (1- cl-count) cl-keys))))
-		cl-seq))
-	  cl-seq)))))
-
-(defun remove-if (cl-pred cl-list &rest cl-keys)
-  "Remove all items satisfying PREDICATE in SEQ.
-This is a non-destructive function; it makes a copy of SEQ if necessary
-to avoid corrupting the original SEQ.
-Keywords supported:  :key :count :start :end :from-end"
-  (apply 'remove* nil cl-list ':if cl-pred cl-keys))
-
-(defun remove-if-not (cl-pred cl-list &rest cl-keys)
-  "Remove all items not satisfying PREDICATE in SEQ.
-This is a non-destructive function; it makes a copy of SEQ if necessary
-to avoid corrupting the original SEQ.
-Keywords supported:  :key :count :start :end :from-end"
-  (apply 'remove* nil cl-list ':if-not cl-pred cl-keys))
-
-(defun delete* (cl-item cl-seq &rest cl-keys)
-  "Remove all occurrences of ITEM in SEQ.
-This is a destructive function; it reuses the storage of SEQ whenever possible.
-Keywords supported:  :test :test-not :key :count :start :end :from-end"
-  (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end
-			(:start 0) :end) ()
-    (if (<= (or cl-count (setq cl-count 8000000)) 0)
-	cl-seq
-      (if (listp cl-seq)
-	  (if (and cl-from-end (< cl-count 4000000))
-	      (let (cl-i)
-		(while (and (>= (setq cl-count (1- cl-count)) 0)
-			    (setq cl-i (cl-position cl-item cl-seq cl-start
-						    cl-end cl-from-end)))
-		  (if (= cl-i 0) (setq cl-seq (cdr cl-seq))
-		    (let ((cl-tail (nthcdr (1- cl-i) cl-seq)))
-		      (setcdr cl-tail (cdr (cdr cl-tail)))))
-		  (setq cl-end cl-i))
-		cl-seq)
-	    (setq cl-end (- (or cl-end 8000000) cl-start))
-	    (if (= cl-start 0)
-		(progn
-		  (while (and cl-seq
-			      (> cl-end 0)
-			      (cl-check-test cl-item (car cl-seq))
-			      (setq cl-end (1- cl-end) cl-seq (cdr cl-seq))
-			      (> (setq cl-count (1- cl-count)) 0)))
-		  (setq cl-end (1- cl-end)))
-	      (setq cl-start (1- cl-start)))
-	    (if (and (> cl-count 0) (> cl-end 0))
-		(let ((cl-p (nthcdr cl-start cl-seq)))
-		  (while (and (cdr cl-p) (> cl-end 0))
-		    (if (cl-check-test cl-item (car (cdr cl-p)))
-			(progn
-			  (setcdr cl-p (cdr (cdr cl-p)))
-			  (if (= (setq cl-count (1- cl-count)) 0)
-			      (setq cl-end 1)))
-		      (setq cl-p (cdr cl-p)))
-		    (setq cl-end (1- cl-end)))))
-	    cl-seq)
-	(apply 'remove* cl-item cl-seq cl-keys)))))
-
-(defun delete-if (cl-pred cl-list &rest cl-keys)
-  "Remove all items satisfying PREDICATE in SEQ.
-This is a destructive function; it reuses the storage of SEQ whenever possible.
-Keywords supported:  :key :count :start :end :from-end"
-  (apply 'delete* nil cl-list ':if cl-pred cl-keys))
-
-(defun delete-if-not (cl-pred cl-list &rest cl-keys)
-  "Remove all items not satisfying PREDICATE in SEQ.
-This is a destructive function; it reuses the storage of SEQ whenever possible.
-Keywords supported:  :key :count :start :end :from-end"
-  (apply 'delete* nil cl-list ':if-not cl-pred cl-keys))
-
-(or (and (fboundp 'delete) (subrp (symbol-function 'delete)))
-    (defalias 'delete (function (lambda (x y) (delete* x y ':test 'equal)))))
-(defun remove (x y) (remove* x y ':test 'equal))
-(defun remq (x y) (if (memq x y) (delq x (copy-list y)) y))
-
-(defun remove-duplicates (cl-seq &rest cl-keys)
-  "Return a copy of SEQ with all duplicate elements removed.
-Keywords supported:  :test :test-not :key :start :end :from-end"
-  (cl-delete-duplicates cl-seq cl-keys t))
-
-(defun delete-duplicates (cl-seq &rest cl-keys)
-  "Remove all duplicate elements from SEQ (destructively).
-Keywords supported:  :test :test-not :key :start :end :from-end"
-  (cl-delete-duplicates cl-seq cl-keys nil))
-
-(defun cl-delete-duplicates (cl-seq cl-keys cl-copy)
-  (if (listp cl-seq)
-      (cl-parsing-keywords (:test :test-not :key (:start 0) :end :from-end :if)
-	  ()
-	(if cl-from-end
-	    (let ((cl-p (nthcdr cl-start cl-seq)) cl-i)
-	      (setq cl-end (- (or cl-end (length cl-seq)) cl-start))
-	      (while (> cl-end 1)
-		(setq cl-i 0)
-		(while (setq cl-i (cl-position (cl-check-key (car cl-p))
-					       (cdr cl-p) cl-i (1- cl-end)))
-		  (if cl-copy (setq cl-seq (copy-sequence cl-seq)
-				    cl-p (nthcdr cl-start cl-seq) cl-copy nil))
-		  (let ((cl-tail (nthcdr cl-i cl-p)))
-		    (setcdr cl-tail (cdr (cdr cl-tail))))
-		  (setq cl-end (1- cl-end)))
-		(setq cl-p (cdr cl-p) cl-end (1- cl-end)
-		      cl-start (1+ cl-start)))
-	      cl-seq)
-	  (setq cl-end (- (or cl-end (length cl-seq)) cl-start))
-	  (while (and (cdr cl-seq) (= cl-start 0) (> cl-end 1)
-		      (cl-position (cl-check-key (car cl-seq))
-				   (cdr cl-seq) 0 (1- cl-end)))
-	    (setq cl-seq (cdr cl-seq) cl-end (1- cl-end)))
-	  (let ((cl-p (if (> cl-start 0) (nthcdr (1- cl-start) cl-seq)
-			(setq cl-end (1- cl-end) cl-start 1) cl-seq)))
-	    (while (and (cdr (cdr cl-p)) (> cl-end 1))
-	      (if (cl-position (cl-check-key (car (cdr cl-p)))
-			       (cdr (cdr cl-p)) 0 (1- cl-end))
-		  (progn
-		    (if cl-copy (setq cl-seq (copy-sequence cl-seq)
-				      cl-p (nthcdr (1- cl-start) cl-seq)
-				      cl-copy nil))
-		    (setcdr cl-p (cdr (cdr cl-p))))
-		(setq cl-p (cdr cl-p)))
-	      (setq cl-end (1- cl-end) cl-start (1+ cl-start)))
-	    cl-seq)))
-    (let ((cl-res (cl-delete-duplicates (append cl-seq nil) cl-keys nil)))
-      (if (stringp cl-seq) (concat cl-res) (vconcat cl-res)))))
-
-(defun substitute (cl-new cl-old cl-seq &rest cl-keys)
-  "Substitute NEW for OLD in SEQ.
-This is a non-destructive function; it makes a copy of SEQ if necessary
-to avoid corrupting the original SEQ.
-Keywords supported:  :test :test-not :key :count :start :end :from-end"
-  (cl-parsing-keywords (:test :test-not :key :if :if-not :count
-			(:start 0) :end :from-end) ()
-    (if (or (eq cl-old cl-new)
-	    (<= (or cl-count (setq cl-from-end nil cl-count 8000000)) 0))
-	cl-seq
-      (let ((cl-i (cl-position cl-old cl-seq cl-start cl-end)))
-	(if (not cl-i)
-	    cl-seq
-	  (setq cl-seq (copy-sequence cl-seq))
-	  (or cl-from-end
-	      (progn (cl-set-elt cl-seq cl-i cl-new)
-		     (setq cl-i (1+ cl-i) cl-count (1- cl-count))))
-	  (apply 'nsubstitute cl-new cl-old cl-seq ':count cl-count
-		 ':start cl-i cl-keys))))))
-
-(defun substitute-if (cl-new cl-pred cl-list &rest cl-keys)
-  "Substitute NEW for all items satisfying PREDICATE in SEQ.
-This is a non-destructive function; it makes a copy of SEQ if necessary
-to avoid corrupting the original SEQ.
-Keywords supported:  :key :count :start :end :from-end"
-  (apply 'substitute cl-new nil cl-list ':if cl-pred cl-keys))
-
-(defun substitute-if-not (cl-new cl-pred cl-list &rest cl-keys)
-  "Substitute NEW for all items not satisfying PREDICATE in SEQ.
-This is a non-destructive function; it makes a copy of SEQ if necessary
-to avoid corrupting the original SEQ.
-Keywords supported:  :key :count :start :end :from-end"
-  (apply 'substitute cl-new nil cl-list ':if-not cl-pred cl-keys))
-
-(defun nsubstitute (cl-new cl-old cl-seq &rest cl-keys)
-  "Substitute NEW for OLD in SEQ.
-This is a destructive function; it reuses the storage of SEQ whenever possible.
-Keywords supported:  :test :test-not :key :count :start :end :from-end"
-  (cl-parsing-keywords (:test :test-not :key :if :if-not :count
-			(:start 0) :end :from-end) ()
-    (or (eq cl-old cl-new) (<= (or cl-count (setq cl-count 8000000)) 0)
-	(if (and (listp cl-seq) (or (not cl-from-end) (> cl-count 4000000)))
-	    (let ((cl-p (nthcdr cl-start cl-seq)))
-	      (setq cl-end (- (or cl-end 8000000) cl-start))
-	      (while (and cl-p (> cl-end 0) (> cl-count 0))
-		(if (cl-check-test cl-old (car cl-p))
-		    (progn
-		      (setcar cl-p cl-new)
-		      (setq cl-count (1- cl-count))))
-		(setq cl-p (cdr cl-p) cl-end (1- cl-end))))
-	  (or cl-end (setq cl-end (length cl-seq)))
-	  (if cl-from-end
-	      (while (and (< cl-start cl-end) (> cl-count 0))
-		(setq cl-end (1- cl-end))
-		(if (cl-check-test cl-old (elt cl-seq cl-end))
-		    (progn
-		      (cl-set-elt cl-seq cl-end cl-new)
-		      (setq cl-count (1- cl-count)))))
-	    (while (and (< cl-start cl-end) (> cl-count 0))
-	      (if (cl-check-test cl-old (aref cl-seq cl-start))
-		  (progn
-		    (aset cl-seq cl-start cl-new)
-		    (setq cl-count (1- cl-count))))
-	      (setq cl-start (1+ cl-start))))))
-    cl-seq))
-
-(defun nsubstitute-if (cl-new cl-pred cl-list &rest cl-keys)
-  "Substitute NEW for all items satisfying PREDICATE in SEQ.
-This is a destructive function; it reuses the storage of SEQ whenever possible.
-Keywords supported:  :key :count :start :end :from-end"
-  (apply 'nsubstitute cl-new nil cl-list ':if cl-pred cl-keys))
-
-(defun nsubstitute-if-not (cl-new cl-pred cl-list &rest cl-keys)
-  "Substitute NEW for all items not satisfying PREDICATE in SEQ.
-This is a destructive function; it reuses the storage of SEQ whenever possible.
-Keywords supported:  :key :count :start :end :from-end"
-  (apply 'nsubstitute cl-new nil cl-list ':if-not cl-pred cl-keys))
-
-(defun find (cl-item cl-seq &rest cl-keys)
-  "Find the first occurrence of ITEM in LIST.
-Return the matching ITEM, or nil if not found.
-Keywords supported:  :test :test-not :key :start :end :from-end"
-  (let ((cl-pos (apply 'position cl-item cl-seq cl-keys)))
-    (and cl-pos (elt cl-seq cl-pos))))
-
-(defun find-if (cl-pred cl-list &rest cl-keys)
-  "Find the first item satisfying PREDICATE in LIST.
-Return the matching ITEM, or nil if not found.
-Keywords supported:  :key :start :end :from-end"
-  (apply 'find nil cl-list ':if cl-pred cl-keys))
-
-(defun find-if-not (cl-pred cl-list &rest cl-keys)
-  "Find the first item not satisfying PREDICATE in LIST.
-Return the matching ITEM, or nil if not found.
-Keywords supported:  :key :start :end :from-end"
-  (apply 'find nil cl-list ':if-not cl-pred cl-keys))
-
-(defun position (cl-item cl-seq &rest cl-keys)
-  "Find the first occurrence of ITEM in LIST.
-Return the index of the matching item, or nil if not found.
-Keywords supported:  :test :test-not :key :start :end :from-end"
-  (cl-parsing-keywords (:test :test-not :key :if :if-not
-			(:start 0) :end :from-end) ()
-    (cl-position cl-item cl-seq cl-start cl-end cl-from-end)))
-
-(defun cl-position (cl-item cl-seq cl-start &optional cl-end cl-from-end)
-  (if (listp cl-seq)
-      (let ((cl-p (nthcdr cl-start cl-seq)))
-	(or cl-end (setq cl-end 8000000))
-	(let ((cl-res nil))
-	  (while (and cl-p (< cl-start cl-end) (or (not cl-res) cl-from-end))
-	    (if (cl-check-test cl-item (car cl-p))
-		(setq cl-res cl-start))
-	    (setq cl-p (cdr cl-p) cl-start (1+ cl-start)))
-	  cl-res))
-    (or cl-end (setq cl-end (length cl-seq)))
-    (if cl-from-end
-	(progn
-	  (while (and (>= (setq cl-end (1- cl-end)) cl-start)
-		      (not (cl-check-test cl-item (aref cl-seq cl-end)))))
-	  (and (>= cl-end cl-start) cl-end))
-      (while (and (< cl-start cl-end)
-		  (not (cl-check-test cl-item (aref cl-seq cl-start))))
-	(setq cl-start (1+ cl-start)))
-      (and (< cl-start cl-end) cl-start))))
-
-(defun position-if (cl-pred cl-list &rest cl-keys)
-  "Find the first item satisfying PREDICATE in LIST.
-Return the index of the matching item, or nil if not found.
-Keywords supported:  :key :start :end :from-end"
-  (apply 'position nil cl-list ':if cl-pred cl-keys))
-
-(defun position-if-not (cl-pred cl-list &rest cl-keys)
-  "Find the first item not satisfying PREDICATE in LIST.
-Return the index of the matching item, or nil if not found.
-Keywords supported:  :key :start :end :from-end"
-  (apply 'position nil cl-list ':if-not cl-pred cl-keys))
-
-(defun count (cl-item cl-seq &rest cl-keys)
-  "Count the number of occurrences of ITEM in LIST.
-Keywords supported:  :test :test-not :key :start :end"
-  (cl-parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end) ()
-    (let ((cl-count 0) cl-x)
-      (or cl-end (setq cl-end (length cl-seq)))
-      (if (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq)))
-      (while (< cl-start cl-end)
-	(setq cl-x (if (consp cl-seq) (cl-pop cl-seq) (aref cl-seq cl-start)))
-	(if (cl-check-test cl-item cl-x) (setq cl-count (1+ cl-count)))
-	(setq cl-start (1+ cl-start)))
-      cl-count)))
-
-(defun count-if (cl-pred cl-list &rest cl-keys)
-  "Count the number of items satisfying PREDICATE in LIST.
-Keywords supported:  :key :start :end"
-  (apply 'count nil cl-list ':if cl-pred cl-keys))
-
-(defun count-if-not (cl-pred cl-list &rest cl-keys)
-  "Count the number of items not satisfying PREDICATE in LIST.
-Keywords supported:  :key :start :end"
-  (apply 'count nil cl-list ':if-not cl-pred cl-keys))
-
-(defun mismatch (cl-seq1 cl-seq2 &rest cl-keys)
-  "Compare SEQ1 with SEQ2, return index of first mismatching element.
-Return nil if the sequences match.  If one sequence is a prefix of the
-other, the return value indicates the end of the shorted sequence.
-Keywords supported:  :test :test-not :key :start1 :end1 :start2 :end2 :from-end"
-  (cl-parsing-keywords (:test :test-not :key :from-end
-			(:start1 0) :end1 (:start2 0) :end2) ()
-    (or cl-end1 (setq cl-end1 (length cl-seq1)))
-    (or cl-end2 (setq cl-end2 (length cl-seq2)))
-    (if cl-from-end
-	(progn
-	  (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
-		      (cl-check-match (elt cl-seq1 (1- cl-end1))
-				      (elt cl-seq2 (1- cl-end2))))
-	    (setq cl-end1 (1- cl-end1) cl-end2 (1- cl-end2)))
-	  (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
-	       (1- cl-end1)))
-      (let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1)))
-	    (cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2))))
-	(while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
-		    (cl-check-match (if cl-p1 (car cl-p1)
-				      (aref cl-seq1 cl-start1))
-				    (if cl-p2 (car cl-p2)
-				      (aref cl-seq2 cl-start2))))
-	  (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)
-		cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2)))
-	(and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
-	     cl-start1)))))
-
-(defun search (cl-seq1 cl-seq2 &rest cl-keys)
-  "Search for SEQ1 as a subsequence of SEQ2.
-Return the index of the leftmost element of the first match found;
-return nil if there are no matches.
-Keywords supported:  :test :test-not :key :start1 :end1 :start2 :end2 :from-end"
-  (cl-parsing-keywords (:test :test-not :key :from-end
-			(:start1 0) :end1 (:start2 0) :end2) ()
-    (or cl-end1 (setq cl-end1 (length cl-seq1)))
-    (or cl-end2 (setq cl-end2 (length cl-seq2)))
-    (if (>= cl-start1 cl-end1)
-	(if cl-from-end cl-end2 cl-start2)
-      (let* ((cl-len (- cl-end1 cl-start1))
-	     (cl-first (cl-check-key (elt cl-seq1 cl-start1)))
-	     (cl-if nil) cl-pos)
-	(setq cl-end2 (- cl-end2 (1- cl-len)))
-	(while (and (< cl-start2 cl-end2)
-		    (setq cl-pos (cl-position cl-first cl-seq2
-					      cl-start2 cl-end2 cl-from-end))
-		    (apply 'mismatch cl-seq1 cl-seq2
-			   ':start1 (1+ cl-start1) ':end1 cl-end1
-			   ':start2 (1+ cl-pos) ':end2 (+ cl-pos cl-len)
-			   ':from-end nil cl-keys))
-	  (if cl-from-end (setq cl-end2 cl-pos) (setq cl-start2 (1+ cl-pos))))
-	(and (< cl-start2 cl-end2) cl-pos)))))
-
-(defun sort* (cl-seq cl-pred &rest cl-keys)
-  "Sort the argument SEQUENCE according to PREDICATE.
-This is a destructive function; it reuses the storage of SEQUENCE if possible.
-Keywords supported:  :key"
-  (if (nlistp cl-seq)
-      (replace cl-seq (apply 'sort* (append cl-seq nil) cl-pred cl-keys))
-    (cl-parsing-keywords (:key) ()
-      (if (memq cl-key '(nil identity))
-	  (sort cl-seq cl-pred)
-	(sort cl-seq (function (lambda (cl-x cl-y)
-				 (funcall cl-pred (funcall cl-key cl-x)
-					  (funcall cl-key cl-y)))))))))
-
-(defun stable-sort (cl-seq cl-pred &rest cl-keys)
-  "Sort the argument SEQUENCE stably according to PREDICATE.
-This is a destructive function; it reuses the storage of SEQUENCE if possible.
-Keywords supported:  :key"
-  (apply 'sort* cl-seq cl-pred cl-keys))
-
-(defun merge (cl-type cl-seq1 cl-seq2 cl-pred &rest cl-keys)
-  "Destructively merge the two sequences to produce a new sequence.
-TYPE is the sequence type to return, SEQ1 and SEQ2 are the two
-argument sequences, and PRED is a `less-than' predicate on the elements.
-Keywords supported:  :key"
-  (or (listp cl-seq1) (setq cl-seq1 (append cl-seq1 nil)))
-  (or (listp cl-seq2) (setq cl-seq2 (append cl-seq2 nil)))
-  (cl-parsing-keywords (:key) ()
-    (let ((cl-res nil))
-      (while (and cl-seq1 cl-seq2)
-	(if (funcall cl-pred (cl-check-key (car cl-seq2))
-		     (cl-check-key (car cl-seq1)))
-	    (cl-push (cl-pop cl-seq2) cl-res)
-	  (cl-push (cl-pop cl-seq1) cl-res)))
-      (coerce (nconc (nreverse cl-res) cl-seq1 cl-seq2) cl-type))))
-
-;;; See compiler macro in cl-macs.el
-(defun member* (cl-item cl-list &rest cl-keys)
-  "Find the first occurrence of ITEM in LIST.
-Return the sublist of LIST whose car is ITEM.
-Keywords supported:  :test :test-not :key"
-  (if cl-keys
-      (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
-	(while (and cl-list (not (cl-check-test cl-item (car cl-list))))
-	  (setq cl-list (cdr cl-list)))
-	cl-list)
-    (if (and (numberp cl-item) (not (integerp cl-item)))
-	(member cl-item cl-list)
-      (memq cl-item cl-list))))
-
-(defun member-if (cl-pred cl-list &rest cl-keys)
-  "Find the first item satisfying PREDICATE in LIST.
-Return the sublist of LIST whose car matches.
-Keywords supported:  :key"
-  (apply 'member* nil cl-list ':if cl-pred cl-keys))
-
-(defun member-if-not (cl-pred cl-list &rest cl-keys)
-  "Find the first item not satisfying PREDICATE in LIST.
-Return the sublist of LIST whose car matches.
-Keywords supported:  :key"
-  (apply 'member* nil cl-list ':if-not cl-pred cl-keys))
-
-(defun cl-adjoin (cl-item cl-list &rest cl-keys)
-  (if (cl-parsing-keywords (:key) t
-	(apply 'member* (cl-check-key cl-item) cl-list cl-keys))
-      cl-list
-    (cons cl-item cl-list)))
-
-;;; See compiler macro in cl-macs.el
-(defun assoc* (cl-item cl-alist &rest cl-keys)
-  "Find the first item whose car matches ITEM in LIST.
-Keywords supported:  :test :test-not :key"
-  (if cl-keys
-      (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
-	(while (and cl-alist
-		    (or (not (consp (car cl-alist)))
-			(not (cl-check-test cl-item (car (car cl-alist))))))
-	  (setq cl-alist (cdr cl-alist)))
-	(and cl-alist (car cl-alist)))
-    (if (and (numberp cl-item) (not (integerp cl-item)))
-	(assoc cl-item cl-alist)
-      (assq cl-item cl-alist))))
-
-(defun assoc-if (cl-pred cl-list &rest cl-keys)
-  "Find the first item whose car satisfies PREDICATE in LIST.
-Keywords supported:  :key"
-  (apply 'assoc* nil cl-list ':if cl-pred cl-keys))
-
-(defun assoc-if-not (cl-pred cl-list &rest cl-keys)
-  "Find the first item whose car does not satisfy PREDICATE in LIST.
-Keywords supported:  :key"
-  (apply 'assoc* nil cl-list ':if-not cl-pred cl-keys))
-
-(defun rassoc* (cl-item cl-alist &rest cl-keys)
-  "Find the first item whose cdr matches ITEM in LIST.
-Keywords supported:  :test :test-not :key"
-  (if (or cl-keys (numberp cl-item))
-      (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
-	(while (and cl-alist
-		    (or (not (consp (car cl-alist)))
-			(not (cl-check-test cl-item (cdr (car cl-alist))))))
-	  (setq cl-alist (cdr cl-alist)))
-	(and cl-alist (car cl-alist)))
-    (rassq cl-item cl-alist)))
-
-(defun rassoc-if (cl-pred cl-list &rest cl-keys)
-  "Find the first item whose cdr satisfies PREDICATE in LIST.
-Keywords supported:  :key"
-  (apply 'rassoc* nil cl-list ':if cl-pred cl-keys))
-
-(defun rassoc-if-not (cl-pred cl-list &rest cl-keys)
-  "Find the first item whose cdr does not satisfy PREDICATE in LIST.
-Keywords supported:  :key"
-  (apply 'rassoc* nil cl-list ':if-not cl-pred cl-keys))
-
-(defun union (cl-list1 cl-list2 &rest cl-keys)
-  "Combine LIST1 and LIST2 using a set-union operation.
-The result list contains all items that appear in either LIST1 or LIST2.
-This is a non-destructive function; it makes a copy of the data if necessary
-to avoid corrupting the original LIST1 and LIST2.
-Keywords supported:  :test :test-not :key"
-  (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
-	((equal cl-list1 cl-list2) cl-list1)
-	(t
-	 (or (>= (length cl-list1) (length cl-list2))
-	     (setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1))))
-	 (while cl-list2
-	   (if (or cl-keys (numberp (car cl-list2)))
-	       (setq cl-list1 (apply 'adjoin (car cl-list2) cl-list1 cl-keys))
-	     (or (memq (car cl-list2) cl-list1)
-		 (cl-push (car cl-list2) cl-list1)))
-	   (cl-pop cl-list2))
-	 cl-list1)))
-
-(defun nunion (cl-list1 cl-list2 &rest cl-keys)
-  "Combine LIST1 and LIST2 using a set-union operation.
-The result list contains all items that appear in either LIST1 or LIST2.
-This is a destructive function; it reuses the storage of LIST1 and LIST2
-whenever possible.
-Keywords supported:  :test :test-not :key"
-  (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
-	(t (apply 'union cl-list1 cl-list2 cl-keys))))
-
-(defun intersection (cl-list1 cl-list2 &rest cl-keys)
-  "Combine LIST1 and LIST2 using a set-intersection operation.
-The result list contains all items that appear in both LIST1 and LIST2.
-This is a non-destructive function; it makes a copy of the data if necessary
-to avoid corrupting the original LIST1 and LIST2.
-Keywords supported:  :test :test-not :key"
-  (and cl-list1 cl-list2
-       (if (equal cl-list1 cl-list2) cl-list1
-	 (cl-parsing-keywords (:key) (:test :test-not)
-	   (let ((cl-res nil))
-	     (or (>= (length cl-list1) (length cl-list2))
-		 (setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1))))
-	     (while cl-list2
-	       (if (if (or cl-keys (numberp (car cl-list2)))
-		       (apply 'member* (cl-check-key (car cl-list2))
-			      cl-list1 cl-keys)
-		     (memq (car cl-list2) cl-list1))
-		   (cl-push (car cl-list2) cl-res))
-	       (cl-pop cl-list2))
-	     cl-res)))))
-
-(defun nintersection (cl-list1 cl-list2 &rest cl-keys)
-  "Combine LIST1 and LIST2 using a set-intersection operation.
-The result list contains all items that appear in both LIST1 and LIST2.
-This is a destructive function; it reuses the storage of LIST1 and LIST2
-whenever possible.
-Keywords supported:  :test :test-not :key"
-  (and cl-list1 cl-list2 (apply 'intersection cl-list1 cl-list2 cl-keys)))
-
-(defun set-difference (cl-list1 cl-list2 &rest cl-keys)
-  "Combine LIST1 and LIST2 using a set-difference operation.
-The result list contains all items that appear in LIST1 but not LIST2.
-This is a non-destructive function; it makes a copy of the data if necessary
-to avoid corrupting the original LIST1 and LIST2.
-Keywords supported:  :test :test-not :key"
-  (if (or (null cl-list1) (null cl-list2)) cl-list1
-    (cl-parsing-keywords (:key) (:test :test-not)
-      (let ((cl-res nil))
-	(while cl-list1
-	  (or (if (or cl-keys (numberp (car cl-list1)))
-		  (apply 'member* (cl-check-key (car cl-list1))
-			 cl-list2 cl-keys)
-		(memq (car cl-list1) cl-list2))
-	      (cl-push (car cl-list1) cl-res))
-	  (cl-pop cl-list1))
-	cl-res))))
-
-(defun nset-difference (cl-list1 cl-list2 &rest cl-keys)
-  "Combine LIST1 and LIST2 using a set-difference operation.
-The result list contains all items that appear in LIST1 but not LIST2.
-This is a destructive function; it reuses the storage of LIST1 and LIST2
-whenever possible.
-Keywords supported:  :test :test-not :key"
-  (if (or (null cl-list1) (null cl-list2)) cl-list1
-    (apply 'set-difference cl-list1 cl-list2 cl-keys)))
-
-(defun set-exclusive-or (cl-list1 cl-list2 &rest cl-keys)
-  "Combine LIST1 and LIST2 using a set-exclusive-or operation.
-The result list contains all items that appear in exactly one of LIST1, LIST2.
-This is a non-destructive function; it makes a copy of the data if necessary
-to avoid corrupting the original LIST1 and LIST2.
-Keywords supported:  :test :test-not :key"
-  (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
-	((equal cl-list1 cl-list2) nil)
-	(t (append (apply 'set-difference cl-list1 cl-list2 cl-keys)
-		   (apply 'set-difference cl-list2 cl-list1 cl-keys)))))
-
-(defun nset-exclusive-or (cl-list1 cl-list2 &rest cl-keys)
-  "Combine LIST1 and LIST2 using a set-exclusive-or operation.
-The result list contains all items that appear in exactly one of LIST1, LIST2.
-This is a destructive function; it reuses the storage of LIST1 and LIST2
-whenever possible.
-Keywords supported:  :test :test-not :key"
-  (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
-	((equal cl-list1 cl-list2) nil)
-	(t (nconc (apply 'nset-difference cl-list1 cl-list2 cl-keys)
-		  (apply 'nset-difference cl-list2 cl-list1 cl-keys)))))
-
-(defun subsetp (cl-list1 cl-list2 &rest cl-keys)
-  "True if LIST1 is a subset of LIST2.
-I.e., if every element of LIST1 also appears in LIST2.
-Keywords supported:  :test :test-not :key"
-  (cond ((null cl-list1) t) ((null cl-list2) nil)
-	((equal cl-list1 cl-list2) t)
-	(t (cl-parsing-keywords (:key) (:test :test-not)
-	     (while (and cl-list1
-			 (apply 'member* (cl-check-key (car cl-list1))
-				cl-list2 cl-keys))
-	       (cl-pop cl-list1))
-	     (null cl-list1)))))
-
-(defun subst-if (cl-new cl-pred cl-tree &rest cl-keys)
-  "Substitute NEW for elements matching PREDICATE in TREE (non-destructively).
-Return a copy of TREE with all matching elements replaced by NEW.
-Keywords supported:  :key"
-  (apply 'sublis (list (cons nil cl-new)) cl-tree ':if cl-pred cl-keys))
-
-(defun subst-if-not (cl-new cl-pred cl-tree &rest cl-keys)
-  "Substitute NEW for elts not matching PREDICATE in TREE (non-destructively).
-Return a copy of TREE with all non-matching elements replaced by NEW.
-Keywords supported:  :key"
-  (apply 'sublis (list (cons nil cl-new)) cl-tree ':if-not cl-pred cl-keys))
-
-(defun nsubst (cl-new cl-old cl-tree &rest cl-keys)
-  "Substitute NEW for OLD everywhere in TREE (destructively).
-Any element of TREE which is `eql' to OLD is changed to NEW (via a call
-to `setcar').
-Keywords supported:  :test :test-not :key"
-  (apply 'nsublis (list (cons cl-old cl-new)) cl-tree cl-keys))
-
-(defun nsubst-if (cl-new cl-pred cl-tree &rest cl-keys)
-  "Substitute NEW for elements matching PREDICATE in TREE (destructively).
-Any element of TREE which matches is changed to NEW (via a call to `setcar').
-Keywords supported:  :key"
-  (apply 'nsublis (list (cons nil cl-new)) cl-tree ':if cl-pred cl-keys))
-
-(defun nsubst-if-not (cl-new cl-pred cl-tree &rest cl-keys)
-  "Substitute NEW for elements not matching PREDICATE in TREE (destructively).
-Any element of TREE which matches is changed to NEW (via a call to `setcar').
-Keywords supported:  :key"
-  (apply 'nsublis (list (cons nil cl-new)) cl-tree ':if-not cl-pred cl-keys))
-
-(defun sublis (cl-alist cl-tree &rest cl-keys)
-  "Perform substitutions indicated by ALIST in TREE (non-destructively).
-Return a copy of TREE with all matching elements replaced.
-Keywords supported:  :test :test-not :key"
-  (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
-    (cl-sublis-rec cl-tree)))
-
-(defvar cl-alist)
-(defun cl-sublis-rec (cl-tree)   ; uses cl-alist/key/test*/if*
-  (let ((cl-temp (cl-check-key cl-tree)) (cl-p cl-alist))
-    (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp)))
-      (setq cl-p (cdr cl-p)))
-    (if cl-p (cdr (car cl-p))
-      (if (consp cl-tree)
-	  (let ((cl-a (cl-sublis-rec (car cl-tree)))
-		(cl-d (cl-sublis-rec (cdr cl-tree))))
-	    (if (and (eq cl-a (car cl-tree)) (eq cl-d (cdr cl-tree)))
-		cl-tree
-	      (cons cl-a cl-d)))
-	cl-tree))))
-
-(defun nsublis (cl-alist cl-tree &rest cl-keys)
-  "Perform substitutions indicated by ALIST in TREE (destructively).
-Any matching element of TREE is changed via a call to `setcar'.
-Keywords supported:  :test :test-not :key"
-  (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
-    (let ((cl-hold (list cl-tree)))
-      (cl-nsublis-rec cl-hold)
-      (car cl-hold))))
-
-(defun cl-nsublis-rec (cl-tree)   ; uses cl-alist/temp/p/key/test*/if*
-  (while (consp cl-tree)
-    (let ((cl-temp (cl-check-key (car cl-tree))) (cl-p cl-alist))
-      (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp)))
-	(setq cl-p (cdr cl-p)))
-      (if cl-p (setcar cl-tree (cdr (car cl-p)))
-	(if (consp (car cl-tree)) (cl-nsublis-rec (car cl-tree))))
-      (setq cl-temp (cl-check-key (cdr cl-tree)) cl-p cl-alist)
-      (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp)))
-	(setq cl-p (cdr cl-p)))
-      (if cl-p
-	  (progn (setcdr cl-tree (cdr (car cl-p))) (setq cl-tree nil))
-	(setq cl-tree (cdr cl-tree))))))
-
-(defun tree-equal (cl-x cl-y &rest cl-keys)
-  "T if trees X and Y have `eql' leaves.
-Atoms are compared by `eql'; cons cells are compared recursively.
-Keywords supported:  :test :test-not :key"
-  (cl-parsing-keywords (:test :test-not :key) ()
-    (cl-tree-equal-rec cl-x cl-y)))
-
-(defun cl-tree-equal-rec (cl-x cl-y)
-  (while (and (consp cl-x) (consp cl-y)
-	      (cl-tree-equal-rec (car cl-x) (car cl-y)))
-    (setq cl-x (cdr cl-x) cl-y (cdr cl-y)))
-  (and (not (consp cl-x)) (not (consp cl-y)) (cl-check-match cl-x cl-y)))
-
-
-(run-hooks 'cl-seq-load-hook)
-
-;;; cl-seq.el ends here
diff --git a/lisp/emacs-lisp/cl-specs.el b/lisp/emacs-lisp/cl-specs.el
deleted file mode 100644
index 38497b26765..00000000000
--- a/lisp/emacs-lisp/cl-specs.el
+++ /dev/null
@@ -1,472 +0,0 @@
-;;; cl-specs.el --- Edebug specs for cl.el
-
-;; Copyright (C) 1993 Free Software Foundation, Inc.
-;; Author: Daniel LaLiberte <liberte@cs.uiuc.edu>
-;; Keywords: lisp, tools, maint
-
-;; LCD Archive Entry:
-;; cl-specs.el|Daniel LaLiberte|liberte@cs.uiuc.edu
-;; |Edebug specs for cl.el
-;; |$Date: 1996/01/05 21:56:25 $|1.1|
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;;; Commentary:
-
-;; These specs are to be used with edebug.el version 3.3 or later and
-;; cl.el version 2.03 or later, by Dave Gillespie <daveg@synaptics.com>.
-
-;; This file need not be byte-compiled, but it shouldn't hurt.
-
-(provide 'cl-specs)
-;; Do the above provide before the following require.
-;; Otherwise if you load this before edebug if cl is already loaded
-;; an infinite loading loop would occur.
-(require 'edebug)
-
-;; Blocks
-
-(def-edebug-spec block (symbolp body))
-(def-edebug-spec return (&optional form))
-(def-edebug-spec return-from (symbolp &optional form))
-
-;; Loops
-
-(def-edebug-spec when t)
-(def-edebug-spec unless t)
-(def-edebug-spec case (form &rest (sexp body)))
-(def-edebug-spec ecase case)
-(def-edebug-spec do
-  ((&rest &or symbolp (symbolp &optional form form))
-   (form body) 
-   cl-declarations body))
-(def-edebug-spec do* do)
-(def-edebug-spec dolist 
-  ((symbolp form &optional form) cl-declarations body))
-(def-edebug-spec dotimes dolist)
-(def-edebug-spec do-symbols
-  ((symbolp &optional form form) cl-declarations body))
-(def-edebug-spec do-all-symbols 
-  ((symbolp &optional form) cl-declarations body))
-
-;; Multiple values
-
-(def-edebug-spec multiple-value-list (form))
-(def-edebug-spec multiple-value-call (function-form body))
-(def-edebug-spec multiple-value-bind 
-  ((&rest symbolp) form cl-declarations body))
-(def-edebug-spec multiple-value-setq ((&rest symbolp) form))
-(def-edebug-spec multiple-value-prog1 (form body))
-
-;; Bindings
-
-(def-edebug-spec lexical-let let)
-(def-edebug-spec lexical-let* let)
-
-(def-edebug-spec psetq setq)
-(def-edebug-spec progv (form form body))
-
-(def-edebug-spec flet ((&rest (defun*)) cl-declarations body))
-(def-edebug-spec labels flet)
-
-(def-edebug-spec macrolet 
-  ((&rest (&define name (&rest arg) cl-declarations-or-string def-body)) 
-   cl-declarations body))
-
-(def-edebug-spec symbol-macrolet 
-  ((&rest (symbol sexp)) cl-declarations body))
-
-(def-edebug-spec destructuring-bind
-  (&define cl-macro-list form cl-declarations def-body))
-
-;; Setf
-
-(def-edebug-spec setf (&rest [place form])) ;; sexp is not specific enough
-(def-edebug-spec psetf setf)
-
-(def-edebug-spec letf  ;; *not* available in Common Lisp
-  ((&rest (gate place &optional form))
-   body))
-(def-edebug-spec letf* letf)
-
-
-(def-edebug-spec defsetf 
-  (&define name 
-	   [&or [symbolp &optional stringp]
-		[cl-lambda-list (symbolp)]]
-	   cl-declarations-or-string def-body))
-
-(def-edebug-spec define-setf-method 
-  (&define name cl-lambda-list cl-declarations-or-string def-body))
-
-(def-edebug-spec define-modify-macro
-  (&define name cl-lambda-list ;; should exclude &key
-	   symbolp &optional stringp))
-
-(def-edebug-spec callf (function* place &rest form))
-(def-edebug-spec callf2 (function* form place &rest form))
-
-;; Other operations on places
-
-(def-edebug-spec remf (place form))
-
-(def-edebug-spec incf (place &optional form))
-(def-edebug-spec decf incf)
-(def-edebug-spec push (form place))
-(def-edebug-spec pushnew 
-  (form place &rest 
-	&or [[&or ":test" ":test-not" ":key"] function-form]
-	[edebug-keywordp form]))
-(def-edebug-spec pop (place))
-
-(def-edebug-spec shiftf (&rest place))  ;; really [&rest place] form
-(def-edebug-spec rotatef (&rest place))
-
-
-;; Functions with function args.  These are only useful if the
-;; function arg is quoted with ' instead of function.
-
-(def-edebug-spec some (function-form form &rest form))
-(def-edebug-spec every some)
-(def-edebug-spec notany some)
-(def-edebug-spec notevery some)
-
-;; Mapping
-
-(def-edebug-spec map (form function-form form &rest form))
-(def-edebug-spec maplist (function-form form &rest form))
-(def-edebug-spec mapc maplist)
-(def-edebug-spec mapl maplist)
-(def-edebug-spec mapcan maplist)
-(def-edebug-spec mapcon maplist)
-
-;; Sequences
-
-(def-edebug-spec reduce (function-form form &rest form))
-
-;; Types and assertions
-
-(def-edebug-spec cl-type-spec (sexp)) ;; not worth the trouble to specify, yet.
-
-(def-edebug-spec deftype defmacro*)
-(def-edebug-spec check-type (place cl-type-spec &optional stringp))
-;; (def-edebug-spec assert (form &optional form stringp &rest form))
-(def-edebug-spec assert (form &rest form))
-(def-edebug-spec typecase (form &rest ([&or cl-type-spec "otherwise"] body)))
-(def-edebug-spec etypecase typecase)
-
-(def-edebug-spec ignore-errors t)
-
-;; Time of Evaluation
-
-(def-edebug-spec eval-when
-  ((&rest &or "compile" "load" "eval") body))
-(def-edebug-spec load-time-value (form &optional &or "t" "nil"))
-
-;; Declarations
-
-(def-edebug-spec cl-decl-spec 
-  ((symbolp &rest sexp)))
-
-(def-edebug-spec cl-declarations
-  (&rest ("declare" &rest cl-decl-spec)))
-
-(def-edebug-spec cl-declarations-or-string
-  (&or stringp cl-declarations))
-
-(def-edebug-spec declaim (&rest cl-decl-spec))
-(def-edebug-spec declare (&rest cl-decl-spec))  ;; probably not needed.
-(def-edebug-spec locally (cl-declarations &rest form))
-(def-edebug-spec the (cl-type-spec form))
-
-;;======================================================
-;; Lambda things
-
-(def-edebug-spec cl-lambda-list
-  (([&rest arg]
-    [&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]]
-    [&optional ["&rest" arg]]
-    [&optional ["&key" [cl-&key-arg &rest cl-&key-arg]
-		&optional "&allow-other-keywords"]]
-    [&optional ["&aux" &rest
-		&or (symbolp &optional def-form) symbolp]]
-    )))
-
-(def-edebug-spec cl-&optional-arg
-  (&or (arg &optional def-form arg) arg))
-
-(def-edebug-spec cl-&key-arg
-  (&or ([&or (symbolp arg) arg] &optional def-form arg) arg))
-
-;; The lambda list for macros is different from that of normal lambdas.
-;; Note that &environment is only allowed as first or last items in the 
-;; top level list.
-
-(def-edebug-spec cl-macro-list
-  (([&optional "&environment" arg]
-    [&rest cl-macro-arg]
-    [&optional ["&optional" &rest 
-		&or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
-    [&optional [[&or "&rest" "&body"] cl-macro-arg]]
-    [&optional ["&key" [&rest 
-			[&or ([&or (symbolp cl-macro-arg) arg] 
-			      &optional def-form cl-macro-arg)
-			     arg]]
-		&optional "&allow-other-keywords"]]
-    [&optional ["&aux" &rest
-		&or (symbolp &optional def-form) symbolp]]
-    [&optional "&environment" arg]
-    )))
-
-(def-edebug-spec cl-macro-arg
-  (&or arg cl-macro-list1))
-
-(def-edebug-spec cl-macro-list1
-  (([&optional "&whole" arg]  ;; only allowed at lower levels
-    [&rest cl-macro-arg]
-    [&optional ["&optional" &rest 
-		&or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
-    [&optional [[&or "&rest" "&body"] cl-macro-arg]]
-    [&optional ["&key" [&rest 
-			[&or ([&or (symbolp cl-macro-arg) arg] 
-			      &optional def-form cl-macro-arg)
-			     arg]]
-		&optional "&allow-other-keywords"]]
-    [&optional ["&aux" &rest
-		&or (symbolp &optional def-form) symbolp]]
-    . [&or arg nil])))
-
-
-(def-edebug-spec defun*
-  ;; Same as defun but use cl-lambda-list.
-  (&define [&or name
-		("setf" :name setf name)]
-	   cl-lambda-list
-	   cl-declarations-or-string
-	   [&optional ("interactive" interactive)]
-	   def-body))
-(def-edebug-spec defsubst* defun*)
-
-(def-edebug-spec defmacro* 
-  (&define name cl-macro-list cl-declarations-or-string def-body))
-(def-edebug-spec define-compiler-macro defmacro*)
-
-
-(def-edebug-spec function*
-  (&or symbolp cl-lambda-expr))
-
-(def-edebug-spec cl-lambda-expr
-  (&define ("lambda" cl-lambda-list
-	    ;;cl-declarations-or-string
-	    ;;[&optional ("interactive" interactive)]
-	    def-body)))
-
-;; Redefine function-form to also match function*
-(def-edebug-spec function-form
-  ;; form at the end could also handle "function",
-  ;; but recognize it specially to avoid wrapping function forms.
-  (&or ([&or "quote" "function"] &or symbolp lambda-expr) 
-       ("function*" cl-lambda-expr)
-       form))
-
-;;======================================================
-;; Structures
-;; (def-edebug-spec defstruct (&rest sexp)) would be sufficient, but...
-
-;; defstruct may contain forms that are evaluated when a structure is created.
-(def-edebug-spec defstruct
-  (&define  ; makes top-level form not be wrapped
-   [&or symbolp
-	(gate
-	 symbolp &rest 
-		 (&or [":conc-name" &or stringp "nil"]
-		      [":constructor" symbolp &optional cl-lambda-list]
-		      [":copier" symbolp]
-		      [":predicate" symbolp]
-		      [":include" symbolp &rest sexp];; not finished
-		      ;; The following are not supported.
-		      ;; [":print-function" ...]
-		      ;; [":type" ...]
-		      ;; [":initial-offset" ...]
-		      ))]
-   [&optional stringp]
-   ;; All the above is for the following def-form.
-   &rest &or symbolp (symbolp def-form &optional ":read-only" sexp)))
-
-;;======================================================
-;; Loop
-
-;; The loop macro is very complex, and a full spec is found below.
-;; The following spec only minimally specifies that
-;; parenthesized forms are executable, but single variables used as
-;; expressions will be missed.  You may want to use this if the full
-;; spec causes problems for you.
-
-(def-edebug-spec loop
-  (&rest &or symbolp form))
-
-;; Below is a complete spec for loop, in several parts that correspond
-;; to the syntax given in CLtL2.  The specs do more than specify where
-;; the forms are; it also specifies, as much as Edebug allows, all the
-;; syntactically legal loop clauses.  The disadvantage of this
-;; completeness is rigidity, but the "for ... being" clause allows
-;; arbitrary extensions of the form: [symbolp &rest &or symbolp form].
-
-(def-edebug-spec loop
-  ([&optional ["named" symbolp]]
-   [&rest 
-    &or
-    ["repeat" form]
-    loop-for-as
-    loop-with
-    loop-initial-final]
-   [&rest loop-clause]
-   ))
-
-(def-edebug-spec loop-with
-  ("with" loop-var
-   loop-type-spec
-   [&optional ["=" form]]
-   &rest ["and" loop-var
-	  loop-type-spec
-	  [&optional ["=" form]]]))
-
-(def-edebug-spec loop-for-as
-  ([&or "for" "as"] loop-for-as-subclause
-   &rest ["and" loop-for-as-subclause]))
-
-(def-edebug-spec loop-for-as-subclause
-  (loop-var 
-   loop-type-spec
-   &or 
-   [[&or "in" "on" "in-ref" "across-ref"]
-    form &optional ["by" function-form]]
-
-   ["=" form &optional ["then" form]]
-   ["across" form]
-   ["being" 
-    [&or "the" "each"]
-    &or 
-    [[&or "element" "elements"] 
-     [&or "of" "in" "of-ref"] form
-     &optional "using" ["index" symbolp]];; is this right?
-    [[&or "hash-key" "hash-keys"
-	  "hash-value" "hash-values"]
-     [&or "of" "in"]
-     hash-table-p &optional ["using" ([&or "hash-value" "hash-values" 
-					   "hash-key" "hash-keys"] sexp)]]
-					
-    [[&or "symbol" "present-symbol" "external-symbol"
-	  "symbols" "present-symbols" "external-symbols"]
-     [&or "in" "of"] package-p]
-     
-    ;; Extensions for Emacs Lisp, including Lucid Emacs.
-    [[&or "frame" "frames"
-	  "screen" "screens"
-	  "buffer" "buffers"]]
-
-    [[&or "window" "windows"] 
-     [&or "of" "in"] form]
-
-    [[&or "overlay" "overlays"
-	  "extent" "extents"]
-     [&or "of" "in"] form
-     &optional [[&or "from" "to"] form]]
-
-    [[&or "interval" "intervals"] 
-     [&or "in" "of"] form
-     &optional [[&or "from" "to"] form]
-     ["property" form]]
-     
-    [[&or "key-code" "key-codes"
-	  "key-seq" "key-seqs"
-	  "key-binding" "key-bindings"] 
-     [&or "in" "of"] form
-     &optional ["using" ([&or "key-code" "key-codes"
-			      "key-seq" "key-seqs"
-			      "key-binding" "key-bindings"] 
-			 sexp)]]
-    ;; For arbitrary extensions, recognize anything else.
-    [symbolp &rest &or symbolp form]
-    ]
-   
-   ;; arithmetic - must be last since all parts are optional.
-   [[&optional [[&or "from" "downfrom" "upfrom"] form]]
-    [&optional [[&or "to" "downto" "upto" "below" "above"] form]]
-    [&optional ["by" form]]
-    ]))
-
-(def-edebug-spec loop-initial-final
-  (&or ["initially" 
-	;; [&optional &or "do" "doing"]  ;; CLtL2 doesn't allow this.
-	&rest loop-non-atomic-expr]
-       ["finally" &or 
-	[[&optional &or "do" "doing"] &rest loop-non-atomic-expr]
-	["return" form]]))
-
-(def-edebug-spec loop-and-clause
-  (loop-clause &rest ["and" loop-clause]))
-
-(def-edebug-spec loop-clause
-  (&or
-   [[&or "while" "until" "always" "never" "thereis"] form]
-     
-   [[&or "collect" "collecting"
-	 "append" "appending"
-	 "nconc" "nconcing"
-	 "concat" "vconcat"] form 
-	 [&optional ["into" loop-var]]]
-
-   [[&or "count" "counting"
-	 "sum" "summing"
-	 "maximize" "maximizing"
-	 "minimize" "minimizing"] form
-	 [&optional ["into" loop-var]]
-	 loop-type-spec]
-
-   [[&or "if" "when" "unless"]
-    form loop-and-clause
-    [&optional ["else" loop-and-clause]]
-    [&optional "end"]]
-
-   [[&or "do" "doing"] &rest loop-non-atomic-expr]
-
-   ["return" form]
-   loop-initial-final
-   ))
-
-(def-edebug-spec loop-non-atomic-expr
-  ([&not atom] form))
-
-(def-edebug-spec loop-var
-  ;; The symbolp must be last alternative to recognize e.g. (a b . c)
-  ;; loop-var => 
-  ;; (loop-var . [&or nil loop-var])
-  ;; (symbolp . [&or nil loop-var])
-  ;; (symbolp . loop-var)
-  ;; (symbolp . (symbolp . [&or nil loop-var]))
-  ;; (symbolp . (symbolp . loop-var))
-  ;; (symbolp . (symbolp . symbolp)) == (symbolp symbolp . symbolp)
-  (&or (loop-var . [&or nil loop-var]) [gate symbolp]))
-
-(def-edebug-spec loop-type-spec
-  (&optional ["of-type" loop-d-type-spec]))
-
-(def-edebug-spec loop-d-type-spec
-  (&or (loop-d-type-spec . [&or nil loop-d-type-spec]) cl-type-spec))
-
diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el
deleted file mode 100644
index 29ec602f231..00000000000
--- a/lisp/emacs-lisp/cl.el
+++ /dev/null
@@ -1,765 +0,0 @@
-;;; cl.el --- Common Lisp extensions for Emacs -*-byte-compile-dynamic: t;-*-
-
-;; Copyright (C) 1993 Free Software Foundation, Inc.
-
-;; Author: Dave Gillespie <daveg@synaptics.com>
-;; Version: 2.02
-;; Keywords: extensions
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; These are extensions to Emacs Lisp that provide a degree of
-;; Common Lisp compatibility, beyond what is already built-in
-;; in Emacs Lisp.
-;;
-;; This package was written by Dave Gillespie; it is a complete
-;; rewrite of Cesar Quiroz's original cl.el package of December 1986.
-;;
-;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19.
-;;
-;; Bug reports, comments, and suggestions are welcome!
-
-;; This file contains the portions of the Common Lisp extensions
-;; package which should always be present.
-
-
-;;; Future notes:
-
-;; Once Emacs 19 becomes standard, many things in this package which are
-;; messy for reasons of compatibility can be greatly simplified.  For now,
-;; I prefer to maintain one unified version.
-
-
-;;; Change Log:
-
-;; Version 2.02 (30 Jul 93):
-;;  * Added "cl-compat.el" file, extra compatibility with old package.
-;;  * Added `lexical-let' and `lexical-let*'.
-;;  * Added `define-modify-macro', `callf', and `callf2'.
-;;  * Added `ignore-errors'.
-;;  * Changed `(setf (nthcdr N PLACE) X)' to work when N is zero.
-;;  * Merged `*gentemp-counter*' into `*gensym-counter*'.
-;;  * Extended `subseq' to allow negative START and END like `substring'.
-;;  * Added `in-ref', `across-ref', `elements of-ref' loop clauses.
-;;  * Added `concat', `vconcat' loop clauses.
-;;  * Cleaned up a number of compiler warnings.
-
-;; Version 2.01 (7 Jul 93):
-;;  * Added support for FSF version of Emacs 19.
-;;  * Added `add-hook' for Emacs 18 users.
-;;  * Added `defsubst*' and `symbol-macrolet'.
-;;  * Added `maplist', `mapc', `mapl', `mapcan', `mapcon'.
-;;  * Added `map', `concatenate', `reduce', `merge'.
-;;  * Added `revappend', `nreconc', `tailp', `tree-equal'.
-;;  * Added `assert', `check-type', `typecase', `typep', and `deftype'.
-;;  * Added destructuring and `&environment' support to `defmacro*'.
-;;  * Added destructuring to `loop', and added the following clauses:
-;;      `elements', `frames', `overlays', `intervals', `buffers', `key-seqs'.
-;;  * Renamed `delete' to `delete*' and `remove' to `remove*'.
-;;  * Completed support for all keywords in `remove*', `substitute', etc.
-;;  * Added `most-positive-float' and company.
-;;  * Fixed hash tables to work with latest Lucid Emacs.
-;;  * `proclaim' forms are no longer compile-time-evaluating; use `declaim'.
-;;  * Syntax for `warn' declarations has changed.
-;;  * Improved implementation of `random*'.
-;;  * Moved most sequence functions to a new file, cl-seq.el.
-;;  * Moved `eval-when' into cl-macs.el.
-;;  * Moved `pushnew' and `adjoin' to cl.el for most common cases.
-;;  * Moved `provide' forms down to ends of files.
-;;  * Changed expansion of `pop' to something that compiles to better code.
-;;  * Changed so that no patch is required for Emacs 19 byte compiler.
-;;  * Made more things dependent on `optimize' declarations.
-;;  * Added a partial implementation of struct print functions.
-;;  * Miscellaneous minor changes.
-
-;; Version 2.00:
-;;  * First public release of this package.
-
-
-;;; Code:
-
-(defvar cl-emacs-type (cond ((or (and (fboundp 'epoch::version)
-				      (symbol-value 'epoch::version))
-				 (string-lessp emacs-version "19")) 18)
-			    ((string-match "Lucid" emacs-version) 'lucid)
-			    (t 19)))
-
-(or (fboundp 'defalias) (fset 'defalias 'fset))
-
-(defvar cl-optimize-speed 1)
-(defvar cl-optimize-safety 1)
-
-
-;;; Keywords used in this package.
-
-(defconst :test ':test)
-(defconst :test-not ':test-not)
-(defconst :key ':key)
-(defconst :start ':start)
-(defconst :start1 ':start1)
-(defconst :start2 ':start2)
-(defconst :end ':end)
-(defconst :end1 ':end1)
-(defconst :end2 ':end2)
-(defconst :count ':count)
-(defconst :initial-value ':initial-value)
-(defconst :size ':size)
-(defconst :from-end ':from-end)
-(defconst :rehash-size ':rehash-size)
-(defconst :rehash-threshold ':rehash-threshold)
-(defconst :allow-other-keys ':allow-other-keys)
-
-
-(defvar custom-print-functions nil
-  "This is a list of functions that format user objects for printing.
-Each function is called in turn with three arguments: the object, the
-stream, and the print level (currently ignored).  If it is able to
-print the object it returns true; otherwise it returns nil and the
-printer proceeds to the next function on the list.
-
-This variable is not used at present, but it is defined in hopes that
-a future Emacs interpreter will be able to use it.")
-
-
-;;; Predicates.
-
-(defun eql (a b)    ; See compiler macro in cl-macs.el
-  "T if the two args are the same Lisp object.
-Floating-point numbers of equal value are `eql', but they may not be `eq'."
-  (if (numberp a)
-      (equal a b)
-    (eq a b)))
-
-
-;;; Generalized variables.  These macros are defined here so that they
-;;; can safely be used in .emacs files.
-
-(defmacro incf (place &optional x)
-  "(incf PLACE [X]): increment PLACE by X (1 by default).
-PLACE may be a symbol, or any generalized variable allowed by `setf'.
-The return value is the incremented value of PLACE."
-  (if (symbolp place)
-      (list 'setq place (if x (list '+ place x) (list '1+ place)))
-    (list 'callf '+ place (or x 1))))
-
-(defmacro decf (place &optional x)
-  "(decf PLACE [X]): decrement PLACE by X (1 by default).
-PLACE may be a symbol, or any generalized variable allowed by `setf'.
-The return value is the decremented value of PLACE."
-  (if (symbolp place)
-      (list 'setq place (if x (list '- place x) (list '1- place)))
-    (list 'callf '- place (or x 1))))
-
-(defmacro pop (place)
-  "(pop PLACE): remove and return the head of the list stored in PLACE.
-Analogous to (prog1 (car PLACE) (setf PLACE (cdr PLACE))), though more
-careful about evaluating each argument only once and in the right order.
-PLACE may be a symbol, or any generalized variable allowed by `setf'."
-  (if (symbolp place)
-      (list 'car (list 'prog1 place (list 'setq place (list 'cdr place))))
-    (cl-do-pop place)))
-
-(defmacro push (x place)
-  "(push X PLACE): insert X at the head of the list stored in PLACE.
-Analogous to (setf PLACE (cons X PLACE)), though more careful about
-evaluating each argument only once and in the right order.  PLACE may
-be a symbol, or any generalized variable allowed by `setf'."
-  (if (symbolp place) (list 'setq place (list 'cons x place))
-    (list 'callf2 'cons x place)))
-
-(defmacro pushnew (x place &rest keys)
-  "(pushnew X PLACE): insert X at the head of the list if not already there.
-Like (push X PLACE), except that the list is unmodified if X is `eql' to
-an element already on the list.
-Keywords supported:  :test :test-not :key"
-  (if (symbolp place) (list 'setq place (list* 'adjoin x place keys))
-    (list* 'callf2 'adjoin x place keys)))
-
-(defun cl-set-elt (seq n val)
-  (if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val)))
-
-(defun cl-set-nthcdr (n list x)
-  (if (<= n 0) x (setcdr (nthcdr (1- n) list) x) list))
-
-(defun cl-set-buffer-substring (start end val)
-  (save-excursion (delete-region start end)
-		  (goto-char start)
-		  (insert val)
-		  val))
-
-(defun cl-set-substring (str start end val)
-  (if end (if (< end 0) (incf end (length str)))
-    (setq end (length str)))
-  (if (< start 0) (incf start str))
-  (concat (and (> start 0) (substring str 0 start))
-	  val
-	  (and (< end (length str)) (substring str end))))
-
-
-;;; Control structures.
-
-;;; These macros are so simple and so often-used that it's better to have
-;;; them all the time than to load them from cl-macs.el.
-
-(defmacro when (cond &rest body)
-  "(when COND BODY...): if COND yields non-nil, do BODY, else return nil."
-  (list 'if cond (cons 'progn body)))
-
-(defmacro unless (cond &rest body)
-  "(unless COND BODY...): if COND yields nil, do BODY, else return nil."
-  (cons 'if (cons cond (cons nil body))))
-
-(defun cl-map-extents (&rest cl-args)
-  (if (fboundp 'next-overlay-at) (apply 'cl-map-overlays cl-args)
-    (if (fboundp 'map-extents) (apply 'map-extents cl-args))))
-
-
-;;; Blocks and exits.
-
-(defalias 'cl-block-wrapper 'identity)
-(defalias 'cl-block-throw 'throw)
-
-
-;;; Multiple values.  True multiple values are not supported, or even
-;;; simulated.  Instead, multiple-value-bind and friends simply expect
-;;; the target form to return the values as a list.
-
-(defalias 'values 'list)
-(defalias 'values-list 'identity)
-(defalias 'multiple-value-list 'identity)
-(defalias 'multiple-value-call 'apply)  ; only works for one arg
-(defalias 'nth-value 'nth)
-
-
-;;; Macros.
-
-(defvar cl-macro-environment nil)
-(defvar cl-old-macroexpand (prog1 (symbol-function 'macroexpand)
-			     (defalias 'macroexpand 'cl-macroexpand)))
-
-(defun cl-macroexpand (cl-macro &optional cl-env)
-  "Return result of expanding macros at top level of FORM.
-If FORM is not a macro call, it is returned unchanged.
-Otherwise, the macro is expanded and the expansion is considered
-in place of FORM.  When a non-macro-call results, it is returned.
-
-The second optional arg ENVIRONMENT species an environment of macro
-definitions to shadow the loaded ones for use in file byte-compilation."
-  (let ((cl-macro-environment cl-env))
-    (while (progn (setq cl-macro (funcall cl-old-macroexpand cl-macro cl-env))
-		  (and (symbolp cl-macro)
-		       (cdr (assq (symbol-name cl-macro) cl-env))))
-      (setq cl-macro (cadr (assq (symbol-name cl-macro) cl-env))))
-    cl-macro))
-
-
-;;; Declarations.
-
-(defvar cl-compiling-file nil)
-(defun cl-compiling-file ()
-  (or cl-compiling-file
-      (and (boundp 'outbuffer) (bufferp (symbol-value 'outbuffer))
-	   (equal (buffer-name (symbol-value 'outbuffer))
-		  " *Compiler Output*"))))
-
-(defvar cl-proclaims-deferred nil)
-
-(defun proclaim (spec)
-  (if (fboundp 'cl-do-proclaim) (cl-do-proclaim spec t)
-    (push spec cl-proclaims-deferred))
-  nil)
-
-(defmacro declaim (&rest specs)
-  (let ((body (mapcar (function (lambda (x) (list 'proclaim (list 'quote x))))
-		      specs)))
-    (if (cl-compiling-file) (list* 'eval-when '(compile load eval) body)
-      (cons 'progn body))))   ; avoid loading cl-macs.el for eval-when
-
-
-;;; Symbols.
-
-(defun cl-random-time ()
-  (let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0))
-    (while (>= (decf i) 0) (setq v (+ (* v 3) (aref time i))))
-    v))
-
-(defvar *gensym-counter* (* (logand (cl-random-time) 1023) 100))
-
-
-;;; Numbers.
-
-(defun floatp-safe (x)
-  "T if OBJECT is a floating point number.
-On Emacs versions that lack floating-point support, this function
-always returns nil."
-  (and (numberp x) (not (integerp x))))
-
-(defun plusp (x)
-  "T if NUMBER is positive."
-  (> x 0))
-
-(defun minusp (x)
-  "T if NUMBER is negative."
-  (< x 0))
-
-(defun oddp (x)
-  "T if INTEGER is odd."
-  (eq (logand x 1) 1))
-
-(defun evenp (x)
-  "T if INTEGER is even."
-  (eq (logand x 1) 0))
-
-(defun cl-abs (x)
-  "Return the absolute value of ARG."
-  (if (>= x 0) x (- x)))
-(or (fboundp 'abs) (defalias 'abs 'cl-abs))   ; This is built-in to Emacs 19
-
-(defvar *random-state* (vector 'cl-random-state-tag -1 30 (cl-random-time)))
-
-;;; We use `eval' in case VALBITS differs from compile-time to load-time.
-(defconst most-positive-fixnum (eval '(lsh -1 -1)))
-(defconst most-negative-fixnum (eval '(- -1 (lsh -1 -1))))
-
-;;; The following are actually set by cl-float-limits.
-(defconst most-positive-float nil)
-(defconst most-negative-float nil)
-(defconst least-positive-float nil)
-(defconst least-negative-float nil)
-(defconst least-positive-normalized-float nil)
-(defconst least-negative-normalized-float nil)
-(defconst float-epsilon nil)
-(defconst float-negative-epsilon nil)
-
-
-;;; Sequence functions.
-
-(defalias 'copy-seq 'copy-sequence)
-
-(defun mapcar* (cl-func cl-x &rest cl-rest)
-  "Apply FUNCTION to each element of SEQ, and make a list of the results.
-If there are several SEQs, FUNCTION is called with that many arguments,
-and mapping stops as soon as the shortest list runs out.  With just one
-SEQ, this is like `mapcar'.  With several, it is like the Common Lisp
-`mapcar' function extended to arbitrary sequence types."
-  (if cl-rest
-      (if (or (cdr cl-rest) (nlistp cl-x) (nlistp (car cl-rest)))
-	  (cl-mapcar-many cl-func (cons cl-x cl-rest))
-	(let ((cl-res nil) (cl-y (car cl-rest)))
-	  (while (and cl-x cl-y)
-	    (push (funcall cl-func (pop cl-x) (pop cl-y)) cl-res))
-	  (nreverse cl-res)))
-    (mapcar cl-func cl-x)))
-
-
-;;; List functions.
-
-(defalias 'first 'car)
-(defalias 'rest 'cdr)
-(defalias 'endp 'null)
-
-(defun second (x)
-  "Return the second element of the list LIST."
-  (car (cdr x)))
-
-(defun third (x)
-  "Return the third element of the list LIST."
-  (car (cdr (cdr x))))
-
-(defun fourth (x)
-  "Return the fourth element of the list LIST."
-  (nth 3 x))
-
-(defun fifth (x)
-  "Return the fifth element of the list LIST."
-  (nth 4 x))
-
-(defun sixth (x)
-  "Return the sixth element of the list LIST."
-  (nth 5 x))
-
-(defun seventh (x)
-  "Return the seventh element of the list LIST."
-  (nth 6 x))
-
-(defun eighth (x)
-  "Return the eighth element of the list LIST."
-  (nth 7 x))
-
-(defun ninth (x)
-  "Return the ninth element of the list LIST."
-  (nth 8 x))
-
-(defun tenth (x)
-  "Return the tenth element of the list LIST."
-  (nth 9 x))
-
-(defun caar (x)
-  "Return the `car' of the `car' of X."
-  (car (car x)))
-
-(defun cadr (x)
-  "Return the `car' of the `cdr' of X."
-  (car (cdr x)))
-
-(defun cdar (x)
-  "Return the `cdr' of the `car' of X."
-  (cdr (car x)))
-
-(defun cddr (x)
-  "Return the `cdr' of the `cdr' of X."
-  (cdr (cdr x)))
-
-(defun caaar (x)
-  "Return the `car' of the `car' of the `car' of X."
-  (car (car (car x))))
-
-(defun caadr (x)
-  "Return the `car' of the `car' of the `cdr' of X."
-  (car (car (cdr x))))
-
-(defun cadar (x)
-  "Return the `car' of the `cdr' of the `car' of X."
-  (car (cdr (car x))))
-
-(defun caddr (x)
-  "Return the `car' of the `cdr' of the `cdr' of X."
-  (car (cdr (cdr x))))
-
-(defun cdaar (x)
-  "Return the `cdr' of the `car' of the `car' of X."
-  (cdr (car (car x))))
-
-(defun cdadr (x)
-  "Return the `cdr' of the `car' of the `cdr' of X."
-  (cdr (car (cdr x))))
-
-(defun cddar (x)
-  "Return the `cdr' of the `cdr' of the `car' of X."
-  (cdr (cdr (car x))))
-
-(defun cdddr (x)
-  "Return the `cdr' of the `cdr' of the `cdr' of X."
-  (cdr (cdr (cdr x))))
-
-(defun caaaar (x)
-  "Return the `car' of the `car' of the `car' of the `car' of X."
-  (car (car (car (car x)))))
-
-(defun caaadr (x)
-  "Return the `car' of the `car' of the `car' of the `cdr' of X."
-  (car (car (car (cdr x)))))
-
-(defun caadar (x)
-  "Return the `car' of the `car' of the `cdr' of the `car' of X."
-  (car (car (cdr (car x)))))
-
-(defun caaddr (x)
-  "Return the `car' of the `car' of the `cdr' of the `cdr' of X."
-  (car (car (cdr (cdr x)))))
-
-(defun cadaar (x)
-  "Return the `car' of the `cdr' of the `car' of the `car' of X."
-  (car (cdr (car (car x)))))
-
-(defun cadadr (x)
-  "Return the `car' of the `cdr' of the `car' of the `cdr' of X."
-  (car (cdr (car (cdr x)))))
-
-(defun caddar (x)
-  "Return the `car' of the `cdr' of the `cdr' of the `car' of X."
-  (car (cdr (cdr (car x)))))
-
-(defun cadddr (x)
-  "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X."
-  (car (cdr (cdr (cdr x)))))
-
-(defun cdaaar (x)
-  "Return the `cdr' of the `car' of the `car' of the `car' of X."
-  (cdr (car (car (car x)))))
-
-(defun cdaadr (x)
-  "Return the `cdr' of the `car' of the `car' of the `cdr' of X."
-  (cdr (car (car (cdr x)))))
-
-(defun cdadar (x)
-  "Return the `cdr' of the `car' of the `cdr' of the `car' of X."
-  (cdr (car (cdr (car x)))))
-
-(defun cdaddr (x)
-  "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X."
-  (cdr (car (cdr (cdr x)))))
-
-(defun cddaar (x)
-  "Return the `cdr' of the `cdr' of the `car' of the `car' of X."
-  (cdr (cdr (car (car x)))))
-
-(defun cddadr (x)
-  "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X."
-  (cdr (cdr (car (cdr x)))))
-
-(defun cdddar (x)
-  "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X."
-  (cdr (cdr (cdr (car x)))))
-
-(defun cddddr (x)
-  "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X."
-  (cdr (cdr (cdr (cdr x)))))
-
-(defun last (x &optional n)
-  "Returns the last link in the list LIST.
-With optional argument N, returns Nth-to-last link (default 1)."
-  (if n
-      (let ((m 0) (p x))
-	(while (consp p) (incf m) (pop p))
-	(if (<= n 0) p
-	  (if (< n m) (nthcdr (- m n) x) x)))
-    (while (consp (cdr x)) (pop x))
-    x))
-
-(defun butlast (x &optional n)
-  "Returns a copy of LIST with the last N elements removed."
-  (if (and n (<= n 0)) x
-    (nbutlast (copy-sequence x) n)))
-
-(defun nbutlast (x &optional n)
-  "Modifies LIST to remove the last N elements."
-  (let ((m (length x)))
-    (or n (setq n 1))
-    (and (< n m)
-	 (progn
-	   (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil))
-	   x))))
-
-(defun list* (arg &rest rest)   ; See compiler macro in cl-macs.el
-  "Return a new list with specified args as elements, cons'd to last arg.
-Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
-`(cons A (cons B (cons C D)))'."
-  (cond ((not rest) arg)
-	((not (cdr rest)) (cons arg (car rest)))
-	(t (let* ((n (length rest))
-		  (copy (copy-sequence rest))
-		  (last (nthcdr (- n 2) copy)))
-	     (setcdr last (car (cdr last)))
-	     (cons arg copy)))))
-
-(defun ldiff (list sublist)
-  "Return a copy of LIST with the tail SUBLIST removed."
-  (let ((res nil))
-    (while (and (consp list) (not (eq list sublist)))
-      (push (pop list) res))
-    (nreverse res)))
-
-(defun copy-list (list)
-  "Return a copy of a list, which may be a dotted list.
-The elements of the list are not copied, just the list structure itself."
-  (if (consp list)
-      (let ((res nil))
-	(while (consp list) (push (pop list) res))
-	(prog1 (nreverse res) (setcdr res list)))
-    (car list)))
-
-(defun cl-maclisp-member (item list)
-  (while (and list (not (equal item (car list)))) (setq list (cdr list)))
-  list)
-
-;;; Define an Emacs 19-compatible `member' for the benefit of Emacs 18 users.
-(or (and (fboundp 'member) (subrp (symbol-function 'member)))
-    (defalias 'member 'cl-maclisp-member))
-
-(defalias 'cl-member 'memq)   ; for compatibility with old CL package
-(defalias 'cl-floor 'floor*)
-(defalias 'cl-ceiling 'ceiling*)
-(defalias 'cl-truncate 'truncate*)
-(defalias 'cl-round 'round*)
-(defalias 'cl-mod 'mod*)
-
-(defun adjoin (cl-item cl-list &rest cl-keys)  ; See compiler macro in cl-macs
-  "Return ITEM consed onto the front of LIST only if it's not already there.
-Otherwise, return LIST unmodified.
-Keywords supported:  :test :test-not :key"
-  (cond ((or (equal cl-keys '(:test eq))
-	     (and (null cl-keys) (not (numberp cl-item))))
-	 (if (memq cl-item cl-list) cl-list (cons cl-item cl-list)))
-	((or (equal cl-keys '(:test equal)) (null cl-keys))
-	 (if (member cl-item cl-list) cl-list (cons cl-item cl-list)))
-	(t (apply 'cl-adjoin cl-item cl-list cl-keys))))
-
-(defun subst (cl-new cl-old cl-tree &rest cl-keys)
-  "Substitute NEW for OLD everywhere in TREE (non-destructively).
-Return a copy of TREE with all elements `eql' to OLD replaced by NEW.
-Keywords supported:  :test :test-not :key"
-  (if (or cl-keys (and (numberp cl-old) (not (integerp cl-old))))
-      (apply 'sublis (list (cons cl-old cl-new)) cl-tree cl-keys)
-    (cl-do-subst cl-new cl-old cl-tree)))
-
-(defun cl-do-subst (cl-new cl-old cl-tree)
-  (cond ((eq cl-tree cl-old) cl-new)
-	((consp cl-tree)
-	 (let ((a (cl-do-subst cl-new cl-old (car cl-tree)))
-	       (d (cl-do-subst cl-new cl-old (cdr cl-tree))))
-	   (if (and (eq a (car cl-tree)) (eq d (cdr cl-tree)))
-	       cl-tree (cons a d))))
-	(t cl-tree)))
-
-(defun acons (a b c) (cons (cons a b) c))
-(defun pairlis (a b &optional c) (nconc (mapcar* 'cons a b) c))
-
-
-;;; Miscellaneous.
-
-(put 'cl-assertion-failed 'error-conditions '(error))
-(put 'cl-assertion-failed 'error-message "Assertion failed")
-
-;;; This is defined in Emacs 19; define it here for Emacs 18 users.
-(defun cl-add-hook (hook func &optional append)
-  "Add to hook variable HOOK the function FUNC.
-FUNC is not added if it already appears on the list stored in HOOK."
-  (let ((old (and (boundp hook) (symbol-value hook))))
-    (and (listp old) (not (eq (car old) 'lambda))
-	 (setq old (list old)))
-    (and (not (member func old))
-	 (set hook (if append (nconc old (list func)) (cons func old))))))
-(or (fboundp 'add-hook) (defalias 'add-hook 'cl-add-hook))
-
-
-;;; Autoload the other portions of the package.
-(mapcar (function
-	 (lambda (set)
-	   (mapcar (function
-		    (lambda (func)
-		      (autoload func (car set) nil nil (nth 1 set))))
-		   (cddr set))))
-	'(("cl-extra" nil
-	   coerce equalp cl-map-keymap maplist mapc mapl mapcan mapcon
-	   cl-map-keymap cl-map-keymap-recursively cl-map-intervals
-	   cl-map-overlays cl-set-frame-visible-p cl-float-limits
-	   gcd lcm isqrt expt floor* ceiling* truncate* round*
-	   mod* rem* signum random* make-random-state random-state-p
-	   subseq concatenate cl-mapcar-many map some every notany
-	   notevery revappend nreconc list-length tailp copy-tree get* getf
-	   cl-set-getf cl-do-remf remprop make-hash-table cl-hash-lookup
-	   gethash cl-puthash remhash clrhash maphash hash-table-p
-	   hash-table-count cl-progv-before cl-prettyexpand
-	   cl-macroexpand-all)
-	  ("cl-seq" nil
-	   reduce fill replace remq remove remove* remove-if remove-if-not
-	   delete delete* delete-if delete-if-not remove-duplicates
-	   delete-duplicates substitute substitute-if substitute-if-not
-	   nsubstitute nsubstitute-if nsubstitute-if-not find find-if
-	   find-if-not position position-if position-if-not count count-if
-	   count-if-not mismatch search sort* stable-sort merge member*
-	   member-if member-if-not cl-adjoin assoc* assoc-if assoc-if-not
-	   rassoc* rassoc rassoc-if rassoc-if-not union nunion intersection
-	   nintersection set-difference nset-difference set-exclusive-or
-	   nset-exclusive-or subsetp subst-if subst-if-not nsubst nsubst-if
-	   nsubst-if-not sublis nsublis tree-equal)
-	  ("cl-macs" nil
-	   gensym gentemp typep cl-do-pop get-setf-method
-	   cl-struct-setf-expander compiler-macroexpand cl-compile-time-init)
-	  ("cl-macs" t
-	   defun* defmacro* function* destructuring-bind eval-when
-	   eval-when-compile load-time-value case ecase typecase etypecase
-	   block return return-from loop do do* dolist dotimes do-symbols
-	   do-all-symbols psetq progv flet labels macrolet symbol-macrolet
-	   lexical-let lexical-let* multiple-value-bind multiple-value-setq
-	   locally the declare define-setf-method defsetf define-modify-macro
-	   setf psetf remf shiftf rotatef letf letf* callf callf2 defstruct
-	   check-type assert ignore-errors define-compiler-macro)))
-
-;;; Define data for indentation and edebug.
-(mapcar (function
-	 (lambda (entry)
-	   (mapcar (function
-		    (lambda (func)
-		      (put func 'lisp-indent-function (nth 1 entry))
-		      (put func 'lisp-indent-hook (nth 1 entry))
-		      (or (get func 'edebug-form-spec)
-			  (put func 'edebug-form-spec (nth 2 entry)))))
-		   (car entry))))
-	'(((defun* defmacro*) 2)
-	  ((function*) nil
-	   (&or symbolp ([&optional 'macro] 'lambda (&rest sexp) &rest form)))
-	  ((eval-when) 1 (sexp &rest form))
-	  ((when unless) 1 (&rest form))
-	  ((declare) nil (&rest sexp))
-	  ((the) 1 (sexp &rest form))
-	  ((case ecase typecase etypecase) 1 (form &rest (sexp &rest form)))
-	  ((block return-from) 1 (sexp &rest form))
-	  ((return) nil (&optional form))
-	  ((do do*) 2 ((&rest &or symbolp (symbolp &optional form form))
-		       (form &rest form)
-		       &rest form))
-	  ((dolist dotimes) 1 ((symbolp form &rest form) &rest form))
-	  ((do-symbols) 1 ((symbolp form &optional form form) &rest form))
-	  ((do-all-symbols) 1 ((symbolp form &optional form) &rest form))
-	  ((psetq setf psetf) nil edebug-setq-form)
-	  ((progv) 2 (&rest form))
-	  ((flet labels macrolet) 1
-	   ((&rest (sexp sexp &rest form)) &rest form))
-	  ((symbol-macrolet lexical-let lexical-let*) 1
-	   ((&rest &or symbolp (symbolp form)) &rest form))
-	  ((multiple-value-bind) 2 ((&rest symbolp) &rest form))
-	  ((multiple-value-setq) 1 ((&rest symbolp) &rest form))
-	  ((incf decf remf pop push pushnew shiftf rotatef) nil (&rest form))
-	  ((letf letf*) 1 ((&rest (&rest form)) &rest form))
-	  ((callf destructuring-bind) 2 (sexp form &rest form))
-	  ((callf2) 3 (sexp form form &rest form))
-	  ((loop) nil (&rest &or symbolp form))
-	  ((ignore-errors) 0 (&rest form))))
-
-
-;;; This goes here so that cl-macs can find it if it loads right now.
-(provide 'cl-19)     ; usage: (require 'cl-19 "cl")
-
-
-;;; Things to do after byte-compiler is loaded.
-;;; As a side effect, we cause cl-macs to be loaded when compiling, so
-;;; that the compiler-macros defined there will be present.
-
-(defvar cl-hacked-flag nil)
-(defun cl-hack-byte-compiler ()
-  (if (and (not cl-hacked-flag) (fboundp 'byte-compile-file-form))
-      (progn
-	(cl-compile-time-init)   ; in cl-macs.el
-	(setq cl-hacked-flag t))))
-
-;;; Try it now in case the compiler has already been loaded.
-(cl-hack-byte-compiler)
-
-;;; Also make a hook in case compiler is loaded after this file.
-;;; The compiler doesn't call any hooks when it loads or runs, but
-;;; we can take advantage of the fact that emacs-lisp-mode will be
-;;; called when the compiler reads in the file to be compiled.
-;;; BUG: If the first compilation is `byte-compile' rather than
-;;; `byte-compile-file', we lose.  Oh, well.
-(add-hook 'emacs-lisp-mode-hook 'cl-hack-byte-compiler)
-
-
-;;; The following ensures that packages which expect the old-style cl.el
-;;; will be happy with this one.
-
-(provide 'cl)
-
-(provide 'mini-cl)   ; for Epoch
-
-(run-hooks 'cl-load-hook)
-
-;;; cl.el ends here
diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el
deleted file mode 100644
index f8ba8c04404..00000000000
--- a/lisp/emacs-lisp/copyright.el
+++ /dev/null
@@ -1,143 +0,0 @@
-;;; copyright.el --- update the copyright notice in current buffer
-
-;; Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: Daniel.Pfeiffer@Informatik.START.dbp.de, fax (+49 69) 7588-2389
-;; Keywords: maint, tools
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Allows updating the copyright year and above mentioned GPL version manually
-;; or when saving a file.  Do (add-hook 'write-file-hooks 'copyright-update).
-
-;;; Code:
-
-(defvar copyright-limit 2000
-  "*Don't try to update copyright beyond this position unless interactive.
-`nil' means to search whole buffer.")
-
-
-(defvar copyright-regexp
-  "\\(\251\\|[Cc]opyright\\s *:?\\s *(C)\\)\\s *\\([1-9][-0-9, ']*[0-9]+\\) "
-  "*What your copyright notice looks like.
-The second \\( \\) construct must match the years.")
-
-
-(defvar copyright-query 'function
-  "*If non-`nil', ask user before changing copyright.
-When this is `function', only ask when called non-interactively.")
-
-
-(defconst copyright-current-year (substring (current-time-string) -4)
-  "String representing the current year.")
-
-
-;; when modifying this, also modify the comment generated by autoinsert.el
-(defconst copyright-current-gpl-version "2"
-  "String representing the current version of the GPL or `nil'.")
-
-(defvar copyright-update t)
-
-;;;###autoload
-(defun copyright-update (&optional arg)
-  "Update the copyright notice at the beginning of the buffer to indicate
-the current year.  If optional prefix ARG is given replace the years in the
-notice rather than adding the current year after them.  If necessary and
-`copyright-current-gpl-version' is set, the copying permissions following the
-copyright, if any, are updated as well."
-  (interactive "*P")
-  (if copyright-update
-      (save-excursion
-	(save-restriction
-	  (widen)
-	  (goto-char (point-min))
-	  (if (re-search-forward copyright-regexp copyright-limit t)
-	      (if (string= (buffer-substring (- (match-end 2) 2) (match-end 2))
-			   (substring copyright-current-year -2))
-		  ()
-		(backward-char 1)
-		(if (or (not copyright-query)
-			(and (eq copyright-query 'function)
-			     (eq this-command 'copyright-update))
-			(y-or-n-p (if arg
-				      (concat "Replace copyright year(s) by "
-					      copyright-current-year "? ")
-				    (concat "Add " copyright-current-year
-					    " to copyright? ")))) 
-		    (if arg
-			(progn
-			  (delete-region (match-beginning 1) (match-end 1))
-			  (insert copyright-current-year))
-		      (setq arg (save-excursion (skip-chars-backward "0-9")))
-		      (if (and (eq (% (- (string-to-number
-					  copyright-current-year)
-					 (string-to-number (buffer-substring
-							    (+ (point) arg)
-							    (point))))
-				      100)
-				   1)
-			       (or (eq (char-after (+ (point) arg -1)) ?-)
-				   (eq (char-after (+ (point) arg -2)) ?-)))
-			  (delete-char arg)
-			(insert ", ")
-			(if (eq (char-after (+ (point) arg -3)) ?')
-			    (insert ?')))
-		      (insert (substring copyright-current-year arg))))))
-	  (goto-char (point-min))
-	  (and copyright-current-gpl-version
-	       ;; match the GPL version comment in .el files, including the
-	       ;; bilingual Esperanto one in two-column, and in texinfo.tex
-	       (re-search-forward "\\(the Free Software Foundation; either \\|; a\\^u eldono \\([0-9]+\\)a, ? a\\^u (la\\^u via	 \\)version \\([0-9]+\\), or (at"
-				  copyright-limit t)
-	       (not (string= (buffer-substring (match-beginning 3) (match-end 3))
-			     copyright-current-gpl-version))
-	       (or (not copyright-query)
-		   (and (eq copyright-query 'function)
-			(eq this-command 'copyright-update))
-		   (y-or-n-p (concat "Replace GPL version by "
-				     copyright-current-gpl-version "? ")))
-	       (progn
-		 (if (match-end 2)
-		     ;; Esperanto bilingual comment in two-column.el
-		     (progn
-		       (delete-region (match-beginning 2) (match-end 2))
-		       (goto-char (match-beginning 2))
-		       (insert copyright-current-gpl-version)))
-		 (delete-region (match-beginning 3) (match-end 3))
-		 (goto-char (match-beginning 3))
-		 (insert copyright-current-gpl-version))))
-	(set (make-local-variable 'copyright-update) nil)))
-  ;; If a write-file-hook returns non-nil, the file is presumed to be written.
-  nil)
-
-
-;;;###autoload
-(define-skeleton copyright
-  "Insert a copyright by $ORGANIZATION notice at cursor."
-  "Company: "
-  comment-start
-  "Copyright (C) " copyright-current-year " by "
-  (or (getenv "ORGANIZATION")
-      str)
-  '(if (> (point) copyright-limit)
-       (message "Copyright extends beyond `copyright-limit' and won't be updated automatically."))
-  comment-end)
-
-;; copyright.el ends here
diff --git a/lisp/emacs-lisp/cust-print.el b/lisp/emacs-lisp/cust-print.el
deleted file mode 100644
index 0c80b6c8bdb..00000000000
--- a/lisp/emacs-lisp/cust-print.el
+++ /dev/null
@@ -1,725 +0,0 @@
-;;; cust-print.el --- handles print-level and print-circle.
-
-;; Copyright (C) 1992 Free Software Foundation, Inc.
-
-;; Author: Daniel LaLiberte <liberte@cs.uiuc.edu>
-;; Adapted-By: ESR
-;; Keywords: extensions
-
-;; LCD Archive Entry:
-;; cust-print|Daniel LaLiberte|liberte@cs.uiuc.edu
-;; |Handle print-level, print-circle and more.
-;; |$Date: 1994/04/05 21:05:09 $|$Revision: 1.14 $|
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; ===============================
-;;; $Header:  $
-;;; $Log: cust-print.el,v $
-;;; Revision 1.14  1994/04/05  21:05:09  liberte
-;;; Change install- and uninstall- to -install and -uninstall.
-;;;
-;;; Revision 1.13  1994/03/24  20:26:05  liberte
-;;; Change "internal" to "original" throughout.
-;;;         (add-custom-printer, delete-custom-printer) replace customizers.
-;;;         (with-custom-print) new
-;;;         (custom-prin1-to-string) Made it more robust.
-;;;
-;;; Revision 1.4  1994/03/23  20:34:29  liberte
-;;; * Change "emacs" to "original" - I just can't decide. 
-;;;
-;;; Revision 1.3  1994/02/21  21:25:36  liberte
-;;; * Make custom-prin1-to-string more robust when errors occur.
-;;; * Change "internal" to "emacs".
-;;;
-;;; Revision 1.2  1993/11/22  22:36:36  liberte
-;;; * Simplified and generalized printer customization.
-;;;     custom-printers is an alist of (PREDICATE . PRINTER) pairs
-;;;     for any data types.  The PRINTER function should print to
-;;;     `standard-output'  add-custom-printer and delete-custom-printer
-;;;     change custom-printers.
-;;;
-;;; * Installation function now called install-custom-print.  The
-;;;     old name is still around for now.
-;;;
-;;; * New macro with-custom-print (added earlier) - executes like
-;;;     progn but with custom-print activated temporarily.
-;;;
-;;; * Cleaned up comments for replacements of standardard printers.
-;;;
-;;; * Changed custom-prin1-to-string to use a temporary buffer.
-;;;
-;;; * Option custom-print-vectors (added earlier) - controls whether
-;;;     vectors should be printed according to print-length and
-;;;     print-length.  Emacs doesnt do this, but cust-print would
-;;;     otherwise do it only if custom printing is required.
-;;;
-;;; * Uninterned symbols are treated as non-read-equivalent.
-;;;
-
-
-;;; Commentary:
-
-;; This package provides a general print handler for prin1 and princ
-;; that supports print-level and print-circle, and by the way,
-;; print-length since the standard routines are being replaced.  Also,
-;; to print custom types constructed from lists and vectors, use
-;; custom-print-list and custom-print-vector.  See the documentation
-;; strings of these variables for more details.  
-
-;; If the results of your expressions contain circular references to
-;; other parts of the same structure, the standard Emacs print
-;; subroutines may fail to print with an untrappable error,
-;; "Apparently circular structure being printed".  If you only use cdr
-;; circular lists (where cdrs of lists point back; what is the right
-;; term here?), you can limit the length of printing with
-;; print-length.  But car circular lists and circular vectors generate
-;; the above mentioned error in Emacs version 18.  Version
-;; 19 supports print-level, but it is often useful to get a better
-;; print representation of circular and shared structures; the print-circle
-;; option may be used to print more concise representations.
-
-;; There are three main ways to use this package.  First, you may
-;; replace prin1, princ, and some subroutines that use them by calling
-;; install-custom-print so that any use of these functions in
-;; Lisp code will be affected; you can later reset with
-;; uninstall-custom-print.  Second, you may temporarily install
-;; these functions with the macro with-custom-print.  Third, you
-;; could call the custom routines directly, thus only affecting the
-;; printing that requires them.
-
-;; Note that subroutines which call print subroutines directly will
-;; not use the custom print functions.  In particular, the evaluation
-;; functions like eval-region call the print subroutines directly.
-;; Therefore, if you evaluate (aref circ-list 0), where circ-list is a
-;; circular list rather than an array, aref calls error directly which
-;; will jump to the top level instead of printing the circular list.
-
-;; Uninterned symbols are recognized when print-circle is non-nil,
-;; but they are not printed specially here.  Use the cl-packages package
-;; to print according to print-gensym.
-
-;; Obviously the right way to implement this custom-print facility is
-;; in C or with hooks into the standard printer.  Please volunteer
-;; since I don't have the time or need.  More CL-like printing
-;; capabilities could be added in the future.
-
-;; Implementation design: we want to use the same list and vector
-;; processing algorithm for all versions of prin1 and princ, since how
-;; the processing is done depends on print-length, print-level, and
-;; print-circle.  For circle printing, a preprocessing step is
-;; required before the final printing.  Thanks to Jamie Zawinski
-;; for motivation and algorithms.
-
-
-;;; Code:
-;;=========================================================
-
-;; If using cl-packages:
-
-'(defpackage "cust-print"
-   (:nicknames "CP" "custom-print")
-   (:use "el")
-   (:export
-    print-level
-    print-circle
-
-    custom-print-install
-    custom-print-uninstall
-    custom-print-installed-p
-    with-custom-print
-
-    custom-prin1
-    custom-princ
-    custom-prin1-to-string
-    custom-print
-    custom-format
-    custom-message
-    custom-error
-
-    custom-printers
-    add-custom-printer
-    ))
-
-'(in-package cust-print)
-
-(require 'backquote)
-
-;; Emacs 18 doesnt have defalias.
-;; Provide def for byte compiler.
-(eval-and-compile
-  (or (fboundp 'defalias) (fset 'defalias 'fset)))
-
-
-;; Variables:
-;;=========================================================
-
-;;(defvar print-length nil
-;;  "*Controls how many elements of a list, at each level, are printed.
-;;This is defined by emacs.")
-
-(defvar print-level nil
-  "*Controls how many levels deep a nested data object will print.  
-
-If nil, printing proceeds recursively and may lead to
-max-lisp-eval-depth being exceeded or an error may occur:
-`Apparently circular structure being printed.'
-Also see `print-length' and `print-circle'.
-
-If non-nil, components at levels equal to or greater than `print-level'
-are printed simply as `#'.  The object to be printed is at level 0,
-and if the object is a list or vector, its top-level components are at
-level 1.")
-
-
-(defvar print-circle nil
-  "*Controls the printing of recursive structures.  
-
-If nil, printing proceeds recursively and may lead to
-`max-lisp-eval-depth' being exceeded or an error may occur:
-\"Apparently circular structure being printed.\"  Also see
-`print-length' and `print-level'.
-
-If non-nil, shared substructures anywhere in the structure are printed
-with `#N=' before the first occurrence (in the order of the print
-representation) and `#N#' in place of each subsequent occurrence,
-where N is a positive decimal integer.
-
-There is no way to read this representation in standard Emacs,
-but if you need to do so, try the cl-read.el package.")
-
-
-(defvar custom-print-vectors nil
-  "*Non-nil if printing of vectors should obey print-level and print-length.
-
-For Emacs 18, setting print-level, or adding custom print list or
-vector handling will make this happen anyway.  Emacs 19 obeys
-print-level, but not for vectors.")
-
-
-;; Custom printers
-;;==========================================================
-
-(defconst custom-printers nil
-  ;; e.g. '((symbolp . pkg::print-symbol))
-  "An alist for custom printing of any type.
-Pairs are of the form (PREDICATE . PRINTER).  If PREDICATE is true
-for an object, then PRINTER is called with the object.
-PRINTER should print to `standard-output' using cust-print-original-princ
-if the standard printer is sufficient, or cust-print-prin for complex things.
-The PRINTER should return the object being printed.
-
-Don't modify this variable directly.  Use `add-custom-printer' and
-`delete-custom-printer'")
-;; Should cust-print-original-princ and cust-print-prin be exported symbols?
-;; Or should the standard printers functions be replaced by
-;; CP ones in elisp so that CP internal functions need not be called?
-
-(defun add-custom-printer (pred printer)
-  "Add a pair of PREDICATE and PRINTER to `custom-printers'.
-Any pair that has the same PREDICATE is first removed."
-  (setq custom-printers (cons (cons pred printer) 
-			      (delq (assq pred custom-printers)
-				    custom-printers)))
-  ;; Rather than updating here, we could wait until cust-print-top-level is called.
-  (cust-print-update-custom-printers))
-
-(defun delete-custom-printer (pred)
-  "Delete the custom printer associated with PREDICATE."
-  (setq custom-printers (delq (assq pred custom-printers)
-			      custom-printers))
-  (cust-print-update-custom-printers))
-
-
-(defun cust-print-use-custom-printer (object)
-  ;; Default function returns nil.
-  nil)
-
-(defun cust-print-update-custom-printers ()
-  ;; Modify the definition of cust-print-use-custom-printer
-  (defalias 'cust-print-use-custom-printer
-    ;; We dont really want to require the byte-compiler.
-    ;; (byte-compile
-     (` (lambda (object)
-	  (cond
-	   (,@ (mapcar (function 
-			(lambda (pair)
-			  (` (((, (car pair)) object) 
-			      ((, (cdr pair)) object)))))
-		       custom-printers))
-	   ;; Otherwise return nil.
-	   (t nil)
-	   )))
-     ;; )
-  ))
-
-
-;; Saving and restoring emacs printing routines.
-;;====================================================
-
-(defun cust-print-set-function-cell (symbol-pair)
-  (defalias (car symbol-pair) 
-    (symbol-function (car (cdr symbol-pair)))))
-
-(defun cust-print-original-princ (object &optional stream)) ; dummy def
-
-;; Save emacs routines.
-(if (not (fboundp 'cust-print-original-prin1))
-    (mapcar 'cust-print-set-function-cell
-	    '((cust-print-original-prin1 prin1)
-	      (cust-print-original-princ princ)
-	      (cust-print-original-print print)
-	      (cust-print-original-prin1-to-string prin1-to-string)
-	      (cust-print-original-format format)
-	      (cust-print-original-message message)
-	      (cust-print-original-error error))))
-
-
-(defun custom-print-install ()
-  "Replace print functions with general, customizable, Lisp versions.
-The emacs subroutines are saved away, and you can reinstall them
-by running `custom-print-uninstall'."
-  (interactive)
-  (mapcar 'cust-print-set-function-cell
-	  '((prin1 custom-prin1)
-	    (princ custom-princ)
-	    (print custom-print)
-	    (prin1-to-string custom-prin1-to-string)
-	    (format custom-format)
-	    (message custom-message)
-	    (error custom-error)
-	    ))
-  t)
-  
-(defun custom-print-uninstall ()
-  "Reset print functions to their emacs subroutines."
-  (interactive)
-  (mapcar 'cust-print-set-function-cell
-	  '((prin1 cust-print-original-prin1)
-	    (princ cust-print-original-princ)
-	    (print cust-print-original-print)
-	    (prin1-to-string cust-print-original-prin1-to-string)
-	    (format cust-print-original-format)
-	    (message cust-print-original-message)
-	    (error cust-print-original-error)
-	    ))
-  t)
-
-(defalias 'custom-print-funcs-installed-p 'custom-print-installed-p)
-(defun custom-print-installed-p ()
-  "Return t if custom-print is currently installed, nil otherwise."
-  (eq (symbol-function 'custom-prin1) (symbol-function 'prin1)))
-
-(put 'with-custom-print-funcs 'edebug-form-spec '(body))
-(put 'with-custom-print 'edebug-form-spec '(body))
-
-(defalias 'with-custom-print-funcs 'with-custom-print)
-(defmacro with-custom-print (&rest body)
-  "Temporarily install the custom print package while executing BODY."
-  (` (unwind-protect
-	 (progn
-	   (custom-print-install)
-	   (,@ body))
-       (custom-print-uninstall))))
-
-
-;; Lisp replacements for prin1 and princ, and for some subrs that use them
-;;===============================================================
-;; - so far only the printing and formatting subrs.
-
-(defun custom-prin1 (object &optional stream)
-  "Output the printed representation of OBJECT, any Lisp object.
-Quoting characters are printed when needed to make output that `read'
-can handle, whenever this is possible.
-Output stream is STREAM, or value of `standard-output' (which see).
-
-This is the custom-print replacement for the standard `prin1'.  It
-uses the appropriate printer depending on the values of `print-level'
-and `print-circle' (which see)."
-  (cust-print-top-level object stream 'cust-print-original-prin1))
-
-
-(defun custom-princ (object &optional stream)
-  "Output the printed representation of OBJECT, any Lisp object.
-No quoting characters are used; no delimiters are printed around
-the contents of strings.
-Output stream is STREAM, or value of `standard-output' (which see).
-
-This is the custom-print replacement for the standard `princ'."
-  (cust-print-top-level object stream 'cust-print-original-princ))
-
-
-(defun custom-prin1-to-string (object)
-  "Return a string containing the printed representation of OBJECT,
-any Lisp object.  Quoting characters are used when needed to make output
-that `read' can handle, whenever this is possible.
-
-This is the custom-print replacement for the standard `prin1-to-string'."
-  (let ((buf (get-buffer-create " *custom-print-temp*")))
-    ;; We must erase the buffer before printing in case an error 
-    ;; occured during the last prin1-to-string and we are in debugger.
-    (save-excursion
-      (set-buffer buf)
-      (erase-buffer))
-    ;; We must be in the current-buffer when the print occurs.
-    (custom-prin1 object buf)
-    (save-excursion
-      (set-buffer buf)
-      (buffer-string)
-      ;; We could erase the buffer again, but why bother?
-      )))
-
-
-(defun custom-print (object &optional stream)
-  "Output the printed representation of OBJECT, with newlines around it.
-Quoting characters are printed when needed to make output that `read'
-can handle, whenever this is possible.
-Output stream is STREAM, or value of `standard-output' (which see).
-
-This is the custom-print replacement for the standard `print'."
-  (cust-print-original-princ "\n" stream)
-  (custom-prin1 object stream)
-  (cust-print-original-princ "\n" stream))
-
-
-(defun custom-format (fmt &rest args)
-  "Format a string out of a control-string and arguments.  
-The first argument is a control string.  It, and subsequent arguments
-substituted into it, become the value, which is a string.
-It may contain %s or %d or %c to substitute successive following arguments.
-%s means print an argument as a string, %d means print as number in decimal,
-%c means print a number as a single character.
-The argument used by %s must be a string or a symbol;
-the argument used by %d, %b, %o, %x or %c must be a number.
-
-This is the custom-print replacement for the standard `format'.  It
-calls the emacs `format' after first making strings for list,
-vector, or symbol args.  The format specification for such args should
-be `%s' in any case, so a string argument will also work.  The string
-is generated with `custom-prin1-to-string', which quotes quotable
-characters."
-  (apply 'cust-print-original-format fmt
-	 (mapcar (function (lambda (arg)
-			     (if (or (listp arg) (vectorp arg) (symbolp arg))
-				 (custom-prin1-to-string arg)
-			       arg)))
-		 args)))
-	    
-  
-(defun custom-message (fmt &rest args)
-  "Print a one-line message at the bottom of the screen.
-The first argument is a control string.
-It may contain %s or %d or %c to print successive following arguments.
-%s means print an argument as a string, %d means print as number in decimal,
-%c means print a number as a single character.
-The argument used by %s must be a string or a symbol;
-the argument used by %d or %c must be a number.
-
-This is the custom-print replacement for the standard `message'.
-See `custom-format' for the details."
-  ;; It doesn't work to princ the result of custom-format as in:
-  ;; (cust-print-original-princ (apply 'custom-format fmt args))
-  ;; because the echo area requires special handling
-  ;; to avoid duplicating the output.  
-  ;; cust-print-original-message does it right.
-  (apply 'cust-print-original-message  fmt
-	 (mapcar (function (lambda (arg)
-			     (if (or (listp arg) (vectorp arg) (symbolp arg))
-				 (custom-prin1-to-string arg)
-			       arg)))
-		 args)))
-	    
-
-(defun custom-error (fmt &rest args)
-  "Signal an error, making error message by passing all args to `format'.
-
-This is the custom-print replacement for the standard `error'.
-See `custom-format' for the details."
-  (signal 'error (list (apply 'custom-format fmt args))))
-
-
-
-;; Support for custom prin1 and princ
-;;=========================================
-
-;; Defs to quiet byte-compiler.
-(defvar circle-table)
-(defvar cust-print-current-level)
-
-(defun cust-print-original-printer (object))  ; One of the standard printers.
-(defun cust-print-low-level-prin (object))    ; Used internally.
-(defun cust-print-prin (object))              ; Call this to print recursively.
-
-(defun cust-print-top-level (object stream emacs-printer)
-  ;; Set up for printing.
-  (let ((standard-output (or stream standard-output))
-	;; circle-table will be non-nil if anything is circular.
-	(circle-table (and print-circle 
-			   (cust-print-preprocess-circle-tree object)))
-	(cust-print-current-level (or print-level -1)))
-
-    (defalias 'cust-print-original-printer emacs-printer)
-    (defalias 'cust-print-low-level-prin 
-      (cond
-       ((or custom-printers
-	    circle-table
-	    print-level			; comment out for version 19
-	    ;; Emacs doesn't use print-level or print-length
-	    ;; for vectors, but custom-print can.
-	    (if custom-print-vectors
-		(or print-level print-length)))
-	'cust-print-print-object)
-       (t 'cust-print-original-printer)))
-    (defalias 'cust-print-prin 
-      (if circle-table 'cust-print-print-circular 'cust-print-low-level-prin))
-
-    (cust-print-prin object)
-    object))
-
-
-(defun cust-print-print-object (object)
-  ;; Test object type and print accordingly.
-  ;; Could be called as either cust-print-low-level-prin or cust-print-prin.
-  (cond 
-   ((null object) (cust-print-original-printer object))
-   ((cust-print-use-custom-printer object) object)
-   ((consp object) (cust-print-list object))
-   ((vectorp object) (cust-print-vector object))
-   ;; All other types, just print.
-   (t (cust-print-original-printer object))))
-
-
-(defun cust-print-print-circular (object)
-  ;; Printer for `prin1' and `princ' that handles circular structures.
-  ;; If OBJECT appears multiply, and has not yet been printed,
-  ;; prefix with label; if it has been printed, use `#N#' instead.
-  ;; Otherwise, print normally.
-  (let ((tag (assq object circle-table)))
-    (if tag
-	(let ((id (cdr tag)))
-	  (if (> id 0)
-	      (progn
-		;; Already printed, so just print id.
-		(cust-print-original-princ "#")
-		(cust-print-original-princ id)
-		(cust-print-original-princ "#"))
-	    ;; Not printed yet, so label with id and print object.
-	    (setcdr tag (- id)) ; mark it as printed
-	    (cust-print-original-princ "#")
-	    (cust-print-original-princ (- id))
-	    (cust-print-original-princ "=")
-	    (cust-print-low-level-prin object)
-	    ))
-      ;; Not repeated in structure.
-      (cust-print-low-level-prin object))))
-
-
-;;================================================
-;; List and vector processing for print functions.
-
-(defun cust-print-list (list)
-  ;; Print a list using print-length, print-level, and print-circle.
-  (if (= cust-print-current-level 0)
-      (cust-print-original-princ "#")
-    (let ((cust-print-current-level (1- cust-print-current-level)))
-      (cust-print-original-princ "(")
-      (let ((length (or print-length 0)))
-
-	;; Print the first element always (even if length = 0).
-	(cust-print-prin (car list))
-	(setq list (cdr list))
-	(if list (cust-print-original-princ " "))
-	(setq length (1- length))
-
-	;; Print the rest of the elements.
-	(while (and list (/= 0 length))
-	  (if (and (listp list)
-		   (not (assq list circle-table)))
-	      (progn
-		(cust-print-prin (car list))
-		(setq list (cdr list)))
-
-	    ;; cdr is not a list, or it is in circle-table.
-	    (cust-print-original-princ ". ")
-	    (cust-print-prin list)
-	    (setq list nil))
-
-	  (setq length (1- length))
-	  (if list (cust-print-original-princ " ")))
-
-	(if (and list (= length 0)) (cust-print-original-princ "..."))
-	(cust-print-original-princ ")"))))
-  list)
-
-
-(defun cust-print-vector (vector)
-  ;; Print a vector according to print-length, print-level, and print-circle.
-  (if (= cust-print-current-level 0)
-      (cust-print-original-princ "#")
-    (let ((cust-print-current-level (1- cust-print-current-level))
-	  (i 0)
-	  (len (length vector)))
-      (cust-print-original-princ "[")
-
-      (if print-length
-	  (setq len (min print-length len)))
-      ;; Print the elements
-      (while (< i len)
-	(cust-print-prin (aref vector i))
-	(setq i (1+ i))
-	(if (< i (length vector)) (cust-print-original-princ " ")))
-
-      (if (< i (length vector)) (cust-print-original-princ "..."))
-      (cust-print-original-princ "]")
-      ))
-  vector)
-
-
-
-;; Circular structure preprocessing
-;;==================================
-
-(defun cust-print-preprocess-circle-tree (object)
-  ;; Fill up the table.  
-  (let (;; Table of tags for each object in an object to be printed.
-	;; A tag is of the form:
-	;; ( <object> <nil-t-or-id-number> )
-	;; The id-number is generated after the entire table has been computed.
-	;; During walk through, the real circle-table lives in the cdr so we
-	;; can use setcdr to add new elements instead of having to setq the
-	;; variable sometimes (poor man's locf).
-	(circle-table (list nil)))
-    (cust-print-walk-circle-tree object)
-
-    ;; Reverse table so it is in the order that the objects will be printed.
-    ;; This pass could be avoided if we always added to the end of the
-    ;; table with setcdr in walk-circle-tree.
-    (setcdr circle-table (nreverse (cdr circle-table)))
-
-    ;; Walk through the table, assigning id-numbers to those
-    ;; objects which will be printed using #N= syntax.  Delete those
-    ;; objects which will be printed only once (to speed up assq later).
-    (let ((rest circle-table)
-	  (id -1))
-      (while (cdr rest)
-	(let ((tag (car (cdr rest))))
-	  (cond ((cdr tag)
-		 (setcdr tag id)
-		 (setq id (1- id))
-		 (setq rest (cdr rest)))
-		;; Else delete this object.
-		(t (setcdr rest (cdr (cdr rest))))))
-	))
-    ;; Drop the car.
-    (cdr circle-table)
-    ))
-
-
-
-(defun cust-print-walk-circle-tree (object)
-  (let (read-equivalent-p tag)
-    (while object
-      (setq read-equivalent-p 
-	    (or (numberp object) 
-		(and (symbolp object)
-		     ;; Check if it is uninterned.
-		     (eq object (intern-soft (symbol-name object)))))
-	    tag (and (not read-equivalent-p)
-		     (assq object (cdr circle-table))))
-      (cond (tag
-	     ;; Seen this object already, so note that.
-	     (setcdr tag t))
-
-	    ((not read-equivalent-p)
-	     ;; Add a tag for this object.
-	     (setcdr circle-table
-		     (cons (list object)
-			   (cdr circle-table)))))
-      (setq object
-	    (cond 
-	     (tag ;; No need to descend since we have already.
-	      nil)
-
-	     ((consp object)
-	      ;; Walk the car of the list recursively.
-	      (cust-print-walk-circle-tree (car object))
-	      ;; But walk the cdr with the above while loop
-	      ;; to avoid problems with max-lisp-eval-depth.
-	      ;; And it should be faster than recursion.
-	      (cdr object))
-
-	     ((vectorp object)
-	      ;; Walk the vector.
-	      (let ((i (length object))
-		    (j 0))
-		(while (< j i)
-		  (cust-print-walk-circle-tree (aref object j))
-		  (setq j (1+ j))))))))))
-
-
-;; Example.
-;;=======================================
-
-'(progn
-   (progn
-     ;; Create some circular structures.
-     (setq circ-sym (let ((x (make-symbol "FOO"))) (list x x)))
-     (setq circ-list (list 'a 'b (vector 1 2 3 4) 'd 'e 'f))
-     (setcar (nthcdr 3 circ-list) circ-list)
-     (aset (nth 2 circ-list) 2 circ-list)
-     (setq dotted-circ-list (list 'a 'b 'c))
-     (setcdr (cdr (cdr dotted-circ-list)) dotted-circ-list)
-     (setq circ-vector (vector 1 2 3 4 (list 'a 'b 'c 'd) 6 7))
-     (aset circ-vector 5 (make-symbol "-gensym-"))
-     (setcar (cdr (aref circ-vector 4)) (aref circ-vector 5))
-     nil)
-
-   (install-custom-print)
-   ;; (setq print-circle t)
-
-   (let ((print-circle t))
-     (or (equal (prin1-to-string circ-list) "#1=(a b [1 2 #1# 4] #1# e f)")
-	 (error "circular object with array printing")))
-
-   (let ((print-circle t))
-     (or (equal (prin1-to-string dotted-circ-list) "#1=(a b c . #1#)")
-	 (error "circular object with array printing")))
-
-   (let* ((print-circle t)
-	  (x (list 'p 'q))
-	  (y (list (list 'a 'b) x 'foo x)))
-     (setcdr (cdr (cdr (cdr y))) (cdr y))
-     (or (equal (prin1-to-string y) "((a b) . #1=(#2=(p q) foo #2# . #1#))"
-		)
-	 (error "circular list example from CL manual")))
-
-   (let ((print-circle nil))
-     ;; cl-packages.el is required to print uninterned symbols like #:FOO.
-     ;; (require 'cl-packages)
-     (or (equal (prin1-to-string circ-sym) "(#:FOO #:FOO)")
-	 (error "uninterned symbols in list")))
-   (let ((print-circle t))
-     (or (equal (prin1-to-string circ-sym) "(#1=FOO #1#)")
-	 (error "circular uninterned symbols in list")))
-
-   (uninstall-custom-print)
-   )
-
-(provide 'cust-print)
-
-;;; cust-print.el ends here
-
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
deleted file mode 100644
index fb2a1324331..00000000000
--- a/lisp/emacs-lisp/debug.el
+++ /dev/null
@@ -1,491 +0,0 @@
-;;; debug.el --- debuggers and related commands for Emacs
-
-;; Copyright (C) 1985, 1986, 1994 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: lisp, tools, maint
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This is a major mode documented in the Emacs manual.
-
-;;; Code:
-
-(defvar debug-function-list nil
-  "List of functions currently set for debug on entry.")
-
-(defvar debugger-step-after-exit nil
-  "Non-nil means \"single-step\" after the debugger exits.")
-
-(defvar debugger-value nil
-  "This is the value for the debugger to return, when it returns.")
-
-(defvar debugger-old-buffer nil
-  "This is the buffer that was current when the debugger was entered.")
-
-(defvar debugger-outer-match-data)
-(defvar debugger-outer-load-read-function)
-(defvar debugger-outer-overriding-local-map)
-(defvar debugger-outer-track-mouse)
-(defvar debugger-outer-last-command)
-(defvar debugger-outer-this-command)
-(defvar debugger-outer-unread-command-char)
-(defvar debugger-outer-unread-command-events)
-(defvar debugger-outer-last-input-event)
-(defvar debugger-outer-last-command-event)
-(defvar debugger-outer-last-nonmenu-event)
-(defvar debugger-outer-last-event-frame)
-(defvar debugger-outer-standard-input)
-(defvar debugger-outer-standard-output)
-(defvar debugger-outer-cursor-in-echo-area)
-
-;;;###autoload
-(setq debugger 'debug)
-;;;###autoload
-(defun debug (&rest debugger-args)
-  "Enter debugger.  To return, type \\<debugger-mode-map>`\\[debugger-continue]'.
-Arguments are mainly for use when this is called from the internals
-of the evaluator.
-
-You may call with no args, or you may pass nil as the first arg and
-any other args you like.  In that case, the list of args after the
-first will be printed into the backtrace buffer."
-  (interactive)
-  (message "Entering debugger...")
-  (let (debugger-value
-	(debug-on-error nil)
-	(debug-on-quit nil)
-	(debugger-buffer (let ((default-major-mode 'fundamental-mode))
-			   (get-buffer-create "*Backtrace*")))
-	(debugger-old-buffer (current-buffer))
-	(debugger-step-after-exit nil)
-	;; Don't keep reading from an executing kbd macro!
-	(executing-kbd-macro nil)
-	;; Save the outer values of these vars for the `e' command
-	;; before we replace the values.
-	(debugger-outer-match-data (match-data))
-	(debugger-outer-load-read-function load-read-function)
-	(debugger-outer-overriding-local-map overriding-local-map)
-	(debugger-outer-track-mouse track-mouse)
-	(debugger-outer-last-command last-command)
-	(debugger-outer-this-command this-command)
-	(debugger-outer-unread-command-char unread-command-char)
-	(debugger-outer-unread-command-events unread-command-events)
-	(debugger-outer-last-input-event last-input-event)
-	(debugger-outer-last-command-event last-command-event)
-	(debugger-outer-last-nonmenu-event last-nonmenu-event)
-	(debugger-outer-last-event-frame last-event-frame)
-	(debugger-outer-standard-input standard-input)
-	(debugger-outer-standard-output standard-output)
-	(debugger-outer-cursor-in-echo-area cursor-in-echo-area))
-    ;; Don't let these magic variables affect the debugger itself.
-    (let ((last-command nil) this-command track-mouse
-	  (unread-command-char -1) unread-command-events
-	  last-input-event last-command-event last-nonmenu-event
-	  last-event-frame
-	  overriding-local-map
-	  load-read-function
-	  (standard-input t) (standard-output t)
-	  (cursor-in-echo-area nil))
-      (unwind-protect
-	  (save-excursion
-	    (save-window-excursion
-	      (pop-to-buffer debugger-buffer)
-	      (erase-buffer)
-	      (let ((standard-output (current-buffer))
-		    (print-escape-newlines t)
-		    (print-length 50))
-		(backtrace))
-	      (goto-char (point-min))
-	      (debugger-mode)
-	      (delete-region (point)
-			     (progn
-			       (search-forward "\n  debug(")
-			       (forward-line 1)
-			       (point)))
-	      (debugger-reenable)
-	      ;; lambda is for debug-on-call when a function call is next.
-	      ;; debug is for debug-on-entry function called.
-	      (cond ((memq (car debugger-args) '(lambda debug))
-		     (insert "Entering:\n")
-		     (if (eq (car debugger-args) 'debug)
-			 (progn
-			   ;; Skip the frames for backtrace-debug, byte-code,
-			   ;; and debug.
-			   (backtrace-debug 3 t)
-			   (delete-char 1)
-			   (insert ?*)
-			   (beginning-of-line))))
-		    ;; Exiting a function.
-		    ((eq (car debugger-args) 'exit)
-		     (insert "Return value: ")
-		     (setq debugger-value (nth 1 debugger-args))
-		     (prin1 debugger-value (current-buffer))
-		     (insert ?\n)
-		     (delete-char 1)
-		     (insert ? )
-		     (beginning-of-line))
-		    ;; Debugger entered for an error.
-		    ((eq (car debugger-args) 'error)
-		     (insert "Signaling: ")
-		     (prin1 (nth 1 debugger-args) (current-buffer))
-		     (insert ?\n))
-		    ;; debug-on-call, when the next thing is an eval.
-		    ((eq (car debugger-args) t)
-		     (insert "Beginning evaluation of function call form:\n"))
-		    ;; User calls debug directly.
-		    (t
-		     (prin1 (if (eq (car debugger-args) 'nil)
-				(cdr debugger-args) debugger-args)
-			    (current-buffer))
-		     (insert ?\n)))
-	      (message "")
-	      (let ((inhibit-trace t)
-		    (standard-output nil)
-		    (buffer-read-only t))
-		(message "")
-		(recursive-edit))))
-	;; Kill or at least neuter the backtrace buffer, so that users
-	;; don't try to execute debugger commands in an invalid context.
-	(if (get-buffer-window debugger-buffer 'visible)
-	    ;; Still visible despite the save-window-excursion?  Maybe it
-	    ;; it's in a pop-up frame.  It would be annoying to delete and
-	    ;; recreate it every time the debugger stops, so instead we'll
-	    ;; erase it but leave it visible.
-	    (save-excursion
-	      (set-buffer debugger-buffer)
-	      (erase-buffer)
-	      (fundamental-mode))
-	  (kill-buffer debugger-buffer))
-	(store-match-data debugger-outer-match-data)))
-    ;; Put into effect the modified values of these variables
-    ;; in case the user set them with the `e' command.
-    (setq load-read-function debugger-outer-load-read-function)
-    (setq overriding-local-map debugger-outer-overriding-local-map)
-    (setq track-mouse debugger-outer-track-mouse)
-    (setq last-command debugger-outer-last-command)
-    (setq this-command debugger-outer-this-command)
-    (setq unread-command-char debugger-outer-unread-command-char)
-    (setq unread-command-events debugger-outer-unread-command-events)
-    (setq last-input-event debugger-outer-last-input-event)
-    (setq last-command-event debugger-outer-last-command-event)
-    (setq last-nonmenu-event debugger-outer-last-nonmenu-event)
-    (setq last-event-frame debugger-outer-last-event-frame)
-    (setq standard-input debugger-outer-standard-input)
-    (setq standard-output debugger-outer-standard-output)
-    (setq cursor-in-echo-area debugger-outer-cursor-in-echo-area)
-    (setq debug-on-next-call debugger-step-after-exit)
-    debugger-value))
-
-(defun debugger-step-through ()
-  "Proceed, stepping through subexpressions of this expression.
-Enter another debugger on next entry to eval, apply or funcall."
-  (interactive)
-  (setq debugger-step-after-exit t)
-  (message "Proceeding, will debug on next eval or call.")
-  (exit-recursive-edit))
-
-(defun debugger-continue ()
-  "Continue, evaluating this expression without stopping."
-  (interactive)
-  (message "Continuing.")
-  (exit-recursive-edit))
-
-(defun debugger-return-value (val)
-  "Continue, specifying value to return.
-This is only useful when the value returned from the debugger
-will be used, such as in a debug on exit from a frame."
-  (interactive "XReturn value (evaluated): ")
-  (setq debugger-value val)
-  (princ "Returning " t)
-  (prin1 debugger-value)
-  (exit-recursive-edit))
-
-(defun debugger-jump ()
-  "Continue to exit from this frame, with all debug-on-entry suspended."
-  (interactive)
-  ;; Compensate for the two extra stack frames for debugger-jump.
-  (let ((debugger-frame-offset (+ debugger-frame-offset 2)))
-    (debugger-frame))
-  ;; Turn off all debug-on-entry functions
-  ;; but leave them in the list.
-  (let ((list debug-function-list))
-    (while list
-      (fset (car list)
-	    (debug-on-entry-1 (car list) (symbol-function (car list)) nil))
-      (setq list (cdr list))))
-  (message "Continuing through this frame")
-  (exit-recursive-edit))
-
-(defun debugger-reenable ()
-  "Turn all debug-on-entry functions back on."
-  (let ((list debug-function-list))
-    (while list
-      (or (consp (symbol-function (car list)))
-	  (debug-convert-byte-code (car list)))
-      (fset (car list)
-	    (debug-on-entry-1 (car list) (symbol-function (car list)) t))
-      (setq list (cdr list)))))
-
-(defun debugger-frame-number ()
-  "Return number of frames in backtrace before the one point points at."
-  (save-excursion
-    (beginning-of-line)
-    (let ((opoint (point))
-	  (count 0))
-      (goto-char (point-min))
-      (if (or (equal (buffer-substring (point) (+ (point) 6))
-		     "Signal")
-	      (equal (buffer-substring (point) (+ (point) 6))
-		     "Return"))
-	  (progn
-	    (search-forward ":")
-	    (forward-sexp 1)))
-      (forward-line 1)
-      (while (progn
-	       (forward-char 2)
-	       (if (= (following-char) ?\()
-		   (forward-sexp 1)
-		 (forward-sexp 2))
-	       (forward-line 1)
-	       (<= (point) opoint))
-	(setq count (1+ count)))
-      count)))
-
-;; Chosen empirically to account for all the frames
-;; that will exist when debugger-frame is called
-;; within the first one that appears in the backtrace buffer.
-;; Assumes debugger-frame is called from a key;
-;; will be wrong if it is called with Meta-x.
-(defconst debugger-frame-offset 8 "")
-
-(defun debugger-frame ()
-  "Request entry to debugger when this frame exits.
-Applies to the frame whose line point is on in the backtrace."
-  (interactive)
-  (beginning-of-line)
-  (let ((level (debugger-frame-number)))
-    (backtrace-debug (+ level debugger-frame-offset) t))
-  (if (= (following-char) ? )
-      (let ((buffer-read-only nil))
-	(delete-char 1)
-	(insert ?*)))
-  (beginning-of-line))
-
-(defun debugger-frame-clear ()
-  "Do not enter to debugger when this frame exits.
-Applies to the frame whose line point is on in the backtrace."
-  (interactive)
-  (beginning-of-line)
-  (let ((level (debugger-frame-number)))
-    (backtrace-debug (+ level debugger-frame-offset) nil))
-  (if (= (following-char) ?*)
-      (let ((buffer-read-only nil))
-	(delete-char 1)
-	(insert ? )))
-  (beginning-of-line))
-
-(defun debugger-eval-expression (exp)
-  "Eval an expression, in an environment like that outside the debugger."
-  (interactive
-   (list (read-from-minibuffer "Eval: "
-			       nil read-expression-map t
-			       'read-expression-history)))
-  (save-excursion
-    (if (null (buffer-name debugger-old-buffer))
-	;; old buffer deleted
-	(setq debugger-old-buffer (current-buffer)))
-    (set-buffer debugger-old-buffer)
-    (let ((track-mouse debugger-outer-track-mouse)
-	  (last-command debugger-outer-last-command)
-	  (this-command debugger-outer-this-command)
-	  (unread-command-char debugger-outer-unread-command-char)
-	  (unread-command-events debugger-outer-unread-command-events)
-	  (last-input-event debugger-outer-last-input-event)
-	  (last-command-event debugger-outer-last-command-event)
-	  (last-nonmenu-event debugger-outer-last-nonmenu-event)
-	  (last-event-frame debugger-outer-last-event-frame)
-	  (standard-input debugger-outer-standard-input)
-	  (standard-output debugger-outer-standard-output)
-	  (cursor-in-echo-area debugger-outer-cursor-in-echo-area)
-	  (overriding-local-map debugger-outer-overriding-local-map)
-	  (load-read-function debugger-outer-load-read-function))
-      (store-match-data debugger-outer-match-data)
-      (prog1 (eval-expression exp)
-	(setq debugger-outer-match-data (match-data))
-	(setq debugger-outer-load-read-function load-read-function)
-	(setq debugger-outer-overriding-local-map overriding-local-map)
-	(setq debugger-outer-track-mouse track-mouse)
-	(setq debugger-outer-last-command last-command)
-	(setq debugger-outer-this-command this-command)
-	(setq debugger-outer-unread-command-char unread-command-char)
-	(setq debugger-outer-unread-command-events unread-command-events)
-	(setq debugger-outer-last-input-event last-input-event)
-	(setq debugger-outer-last-command-event last-command-event)
-	(setq debugger-outer-last-nonmenu-event last-nonmenu-event)
-	(setq debugger-outer-last-event-frame last-event-frame)
-	(setq debugger-outer-standard-input standard-input)
-	(setq debugger-outer-standard-output standard-output)
-	(setq debugger-outer-cursor-in-echo-area cursor-in-echo-area)))))
-
-(defvar debugger-mode-map nil)
-(if debugger-mode-map
-    nil
-  (let ((loop ? ))
-    (setq debugger-mode-map (make-keymap))
-    (suppress-keymap debugger-mode-map)
-    (define-key debugger-mode-map "-" 'negative-argument)
-    (define-key debugger-mode-map "b" 'debugger-frame)
-    (define-key debugger-mode-map "c" 'debugger-continue)
-    (define-key debugger-mode-map "j" 'debugger-jump)
-    (define-key debugger-mode-map "r" 'debugger-return-value)
-    (define-key debugger-mode-map "u" 'debugger-frame-clear)
-    (define-key debugger-mode-map "d" 'debugger-step-through)
-    (define-key debugger-mode-map "l" 'debugger-list-functions)
-    (define-key debugger-mode-map "h" 'describe-mode)
-    (define-key debugger-mode-map "q" 'top-level)
-    (define-key debugger-mode-map "e" 'debugger-eval-expression)
-    (define-key debugger-mode-map " " 'next-line)))
-
-(put 'debugger-mode 'mode-class 'special)
-
-(defun debugger-mode ()
-  "Mode for backtrace buffers, selected in debugger.
-\\<debugger-mode-map>
-A line starts with `*' if exiting that frame will call the debugger.
-Type \\[debugger-frame] or \\[debugger-frame-clear] to set or remove the `*'.
-
-When in debugger due to frame being exited,
-use the \\[debugger-return-value] command to override the value
-being returned from that frame.
-
-Use \\[debug-on-entry] and \\[cancel-debug-on-entry] to control
-which functions will enter the debugger when called.
-
-Complete list of commands:
-\\{debugger-mode-map}"
-  (kill-all-local-variables)    
-  (setq major-mode 'debugger-mode)
-  (setq mode-name "Debugger")
-  (setq truncate-lines t)
-  (set-syntax-table emacs-lisp-mode-syntax-table)
-  (use-local-map debugger-mode-map))
-
-;;;###autoload
-(defun debug-on-entry (function)
-  "Request FUNCTION to invoke debugger each time it is called.
-If you tell the debugger to continue, FUNCTION's execution proceeds.
-This works by modifying the definition of FUNCTION,
-which must be written in Lisp, not predefined.
-Use \\[cancel-debug-on-entry] to cancel the effect of this command.
-Redefining FUNCTION also cancels it."
-  (interactive "aDebug on entry (to function): ")
-  (debugger-reenable)
-  (if (subrp (symbol-function function))
-      (error "Function %s is a primitive" function))
-  (or (consp (symbol-function function))
-      (debug-convert-byte-code function))
-  (or (consp (symbol-function function))
-      (error "Definition of %s is not a list" function))
-  (fset function (debug-on-entry-1 function (symbol-function function) t))
-  (or (memq function debug-function-list)
-      (setq debug-function-list (cons function debug-function-list)))
-  function)
-
-;;;###autoload
-(defun cancel-debug-on-entry (&optional function)
-  "Undo effect of \\[debug-on-entry] on FUNCTION.
-If argument is nil or an empty string, cancel for all functions."
-  (interactive
-   (list (let ((name
-		(completing-read "Cancel debug on entry (to function): "
-				 ;; Make an "alist" of the functions
-				 ;; that now have debug on entry.
-				 (mapcar 'list
-					 (mapcar 'symbol-name
-						 debug-function-list))
-				 nil t nil)))
-	   (if name (intern name)))))
-  (debugger-reenable)
-  (if (and function (not (string= function "")))
-      (progn
-	(fset function
-	      (debug-on-entry-1 function (symbol-function function) nil))
-	(setq debug-function-list (delq function debug-function-list))
-	function)
-    (message "Cancelling debug-on-entry for all functions")
-    (mapcar 'cancel-debug-on-entry debug-function-list)))
-
-(defun debug-convert-byte-code (function)
-  (let ((defn (symbol-function function)))
-    (if (not (consp defn))
-	;; Assume a compiled code object.
-	(let* ((contents (append defn nil))
-	       (body
-		(list (list 'byte-code (nth 1 contents)
-			    (nth 2 contents) (nth 3 contents)))))
-	  (if (nthcdr 5 contents)
-	      (setq body (cons (list 'interactive (nth 5 contents)) body)))
-	  (if (nth 4 contents)
-	      ;; Use `documentation' here, to get the actual string,
-	      ;; in case the compiled function has a reference
-	      ;; to the .elc file.
-	      (setq body (cons (documentation function) body)))
-	  (fset function (cons 'lambda (cons (car contents) body)))))))
-
-(defun debug-on-entry-1 (function defn flag)
-  (if (subrp defn)
-      (error "%s is a built-in function" function)
-    (if (eq (car defn) 'macro)
-	(debug-on-entry-1 function (cdr defn) flag)
-      (or (eq (car defn) 'lambda)
-	  (error "%s not user-defined Lisp function" function))
-      (let (tail prec)
-	(if (stringp (car (nthcdr 2 defn)))
-	    (setq tail (nthcdr 3 defn)
-		  prec (list (car defn) (car (cdr defn))
-			     (car (cdr (cdr defn)))))
-	  (setq tail (nthcdr 2 defn)
-		prec (list (car defn) (car (cdr defn)))))
-	(if (eq flag (equal (car tail) '(debug 'debug)))
-	    defn
-	  (if flag
-	      (nconc prec (cons '(debug 'debug) tail))
-	    (nconc prec (cdr tail))))))))
-
-(defun debugger-list-functions ()
-  "Display a list of all the functions now set to debug on entry."
-  (interactive)
-  (with-output-to-temp-buffer "*Help*"
-    (if (null debug-function-list)
-	(princ "No debug-on-entry functions now\n")
-      (princ "Functions set to debug on entry:\n\n")
-      (let ((list debug-function-list))
-	(while list
-	  (prin1 (car list))
-	  (terpri)
-	  (setq list (cdr list))))
-      (princ "Note: if you have redefined a function, then it may no longer\n")
-      (princ "be set to debug on entry, even if it is in the list."))
-    (save-excursion
-      (set-buffer standard-output)
-      (help-mode))))
-
-;;; debug.el ends here
diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el
deleted file mode 100644
index 4199728888e..00000000000
--- a/lisp/emacs-lisp/disass.el
+++ /dev/null
@@ -1,266 +0,0 @@
-;;; disass.el --- disassembler for compiled Emacs Lisp code
-
-;; Copyright (C) 1986, 1991 Free Software Foundation, Inc.
-
-;; Author: Doug Cutting <doug@csli.stanford.edu>
-;;	Jamie Zawinski <jwz@lucid.com>
-;; Maintainer: Jamie Zawinski <jwz@lucid.com>
-;; Keywords: internal
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; The single entry point, `disassemble', disassembles a code object generated
-;; by the Emacs Lisp byte-compiler.  This doesn't invert the compilation
-;; operation, not by a long shot, but it's useful for debugging.
-
-;;
-;; Original version by Doug Cutting (doug@csli.stanford.edu)
-;; Substantially modified by Jamie Zawinski <jwz@lucid.com> for
-;; the new lapcode-based byte compiler.
-
-;;; Code:
-
-;;; The variable byte-code-vector is defined by the new bytecomp.el.
-;;; The function byte-decompile-lapcode is defined in byte-opt.el.
-;;; Since we don't use byte-decompile-lapcode, let's try not loading byte-opt.
-(require 'byte-compile "bytecomp")
-
-(defvar disassemble-column-1-indent 8 "*")
-(defvar disassemble-column-2-indent 10 "*")
-
-(defvar disassemble-recursive-indent 3 "*")
-
-;;;###autoload
-(defun disassemble (object &optional buffer indent interactive-p)
-  "Print disassembled code for OBJECT in (optional) BUFFER.
-OBJECT can be a symbol defined as a function, or a function itself
-\(a lambda expression or a compiled-function object).
-If OBJECT is not already compiled, we compile it, but do not
-redefine OBJECT if it is a symbol."
-  (interactive (list (intern (completing-read "Disassemble function: "
-					      obarray 'fboundp t))
-		     nil 0 t))
-  (if (eq (car-safe object) 'byte-code)
-      (setq object (list 'lambda () object)))
-  (or indent (setq indent 0))		;Default indent to zero
-  (save-excursion
-    (if (or interactive-p (null buffer))
-	(with-output-to-temp-buffer "*Disassemble*"
-	  (set-buffer "*Disassemble*")
-	  (disassemble-internal object indent (not interactive-p)))
-      (set-buffer buffer)
-      (disassemble-internal object indent nil)))
-  nil)
-
-
-(defun disassemble-internal (obj indent interactive-p)
-  (let ((macro 'nil)
-	(name 'nil)
-	(doc 'nil)
-	args)
-    (while (symbolp obj)
-      (setq name obj
-	    obj (symbol-function obj)))
-    (if (subrp obj)
-	(error "Can't disassemble #<subr %s>" name))
-    (if (and (listp obj) (eq (car obj) 'autoload))
-	(progn
-	  (load (nth 1 obj))
-	  (setq obj (symbol-function name))))
-    (if (eq (car-safe obj) 'macro)	;handle macros
-	(setq macro t
-	      obj (cdr obj)))
-    (if (and (listp obj) (eq (car obj) 'byte-code))
-	(setq obj (list 'lambda nil obj)))	
-    (if (and (listp obj) (not (eq (car obj) 'lambda)))
-	(error "not a function"))
-    (if (consp obj)
-	(if (assq 'byte-code obj)
-	    nil
-	  (if interactive-p (message (if name
-					 "Compiling %s's definition..."
-				       "Compiling definition...")
-				     name))
-	  (setq obj (byte-compile obj))
-	  (if interactive-p (message "Done compiling.  Disassembling..."))))
-    (cond ((consp obj)
-	   (setq obj (cdr obj))		;throw lambda away
-	   (setq args (car obj))	;save arg list
-	   (setq obj (cdr obj)))
-	  ((byte-code-function-p obj)
-	   (setq args (aref obj 0)))
-          (t (error "Compilation failed")))
-    (if (zerop indent) ; not a nested function
-	(progn
-	  (indent-to indent)
-	  (insert (format "byte code%s%s%s:\n"
-			  (if (or macro name) " for" "")
-			  (if macro " macro" "")
-			  (if name (format " %s" name) "")))))
-    (let ((doc (if (consp obj)
-		   (and (stringp (car obj)) (car obj))
-		 ;; Use documentation to get lazy-loaded doc string
-		 (documentation obj t))))
-      (if (and doc (stringp doc))
-	  (progn (and (consp obj) (setq obj (cdr obj)))
-		 (indent-to indent)
-		 (princ "  doc:  " (current-buffer))
-		 (if (string-match "\n" doc)
-		     (setq doc (concat (substring doc 0 (match-beginning 0))
-				       " ...")))
-		 (insert doc "\n"))))
-    (indent-to indent)
-    (insert "  args: ")
-    (prin1 args (current-buffer))
-    (insert "\n")
-    (let ((interactive (cond ((consp obj)
-			      (assq 'interactive obj))
-			     ((> (length obj) 5)
-			      (list 'interactive (aref obj 5))))))
-      (if interactive
-	  (progn
-	    (setq interactive (nth 1 interactive))
-	    (if (eq (car-safe (car-safe obj)) 'interactive)
-		(setq obj (cdr obj)))
-	    (indent-to indent)
-	    (insert " interactive: ")
-	    (if (eq (car-safe interactive) 'byte-code)
-		(progn
-		  (insert "\n")
-		  (disassemble-1 interactive
-				 (+ indent disassemble-recursive-indent)))
-	      (let ((print-escape-newlines t))
-		(prin1 interactive (current-buffer))))
-	    (insert "\n"))))
-    (cond ((and (consp obj) (assq 'byte-code obj))
-	   (disassemble-1 (assq 'byte-code obj) indent))
-	  ((byte-code-function-p obj)
-	   (disassemble-1 obj indent))
-	  (t
-	   (insert "Uncompiled body:  ")
-	   (let ((print-escape-newlines t))
-	     (prin1 (if (cdr obj) (cons 'progn obj) (car obj))
-		    (current-buffer))))))
-  (if interactive-p
-      (message "")))
-
-
-(defun disassemble-1 (obj indent)
-  "Prints the byte-code call OBJ in the current buffer.
-OBJ should be a call to BYTE-CODE generated by the byte compiler."
-  (let (bytes constvec)
-    (if (consp obj)
-	(setq bytes (car (cdr obj))		;the byte code
-	      constvec (car (cdr (cdr obj))))	;constant vector
-      ;; If it is lazy-loaded, load it now
-      (fetch-bytecode obj)
-      (setq bytes (aref obj 1)
-	    constvec (aref obj 2)))
-    (let ((lap (byte-decompile-bytecode bytes constvec))
-	  op arg opname pc-value)
-      (let ((tagno 0)
-	    tmp
-	    (lap lap))
-	(while (setq tmp (assq 'TAG lap))
-	  (setcar (cdr tmp) (setq tagno (1+ tagno)))
-	  (setq lap (cdr (memq tmp lap)))))
-      (while lap
-	;; Take off the pc value of the next thing
-	;; and put it in pc-value.
-	(setq pc-value nil)
-	(if (numberp (car lap))
-	    (setq pc-value (car lap)
-		  lap (cdr lap)))
-	;; Fetch the next op and its arg.
-	(setq op (car (car lap))
-	      arg (cdr (car lap)))
-	(setq lap (cdr lap))
-	(indent-to indent)
-	(if (eq 'TAG op)
-	    (progn
-	      ;; We have a label.  Display it, but first its pc value.
-	      (if pc-value
-		  (insert (format "%d:" pc-value)))
-	      (insert (int-to-string (car arg))))
-	  ;; We have an instruction.  Display its pc value first.
-	  (if pc-value
-	      (insert (format "%d" pc-value)))
-	  (indent-to (+ indent disassemble-column-1-indent))
-	  (if (and op
-		   (string-match "^byte-" (setq opname (symbol-name op))))
-	      (setq opname (substring opname 5))
-	    (setq opname "<not-an-opcode>"))
-	  (if (eq op 'byte-constant2)
-	      (insert " #### shouldn't have seen constant2 here!\n  "))
-	  (insert opname)
-	  (indent-to (+ indent disassemble-column-1-indent
-			disassemble-column-2-indent
-			-1))
-	  (insert " ")
-	  (cond ((memq op byte-goto-ops)
-		 (insert (int-to-string (nth 1 arg))))
-		((memq op '(byte-call byte-unbind
-			    byte-listN byte-concatN byte-insertN))
-		 (insert (int-to-string arg)))
-		((memq op '(byte-varref byte-varset byte-varbind))
-		 (prin1 (car arg) (current-buffer)))
-		((memq op '(byte-constant byte-constant2))
-		 ;; it's a constant
-		 (setq arg (car arg))
-		 ;; but if the value of the constant is compiled code, then
-		 ;; recursively disassemble it.
-		 (cond ((or (byte-code-function-p arg)
-			    (and (eq (car-safe arg) 'lambda)
-				 (assq 'byte-code arg))
-			    (and (eq (car-safe arg) 'macro)
-				 (or (byte-code-function-p (cdr arg))
-				     (and (eq (car-safe (cdr arg)) 'lambda)
-					  (assq 'byte-code (cdr arg))))))
-			(cond ((byte-code-function-p arg)
-			       (insert "<compiled-function>\n"))
-			      ((eq (car-safe arg) 'lambda)
-			       (insert "<compiled lambda>"))
-			      (t (insert "<compiled macro>\n")))
-			(disassemble-internal
-			 arg
-			 (+ indent disassemble-recursive-indent 1)
-			 nil))
-		       ((eq (car-safe arg) 'byte-code)
-			(insert "<byte code>\n")
-			(disassemble-1	;recurse on byte-code object
-			 arg
-			 (+ indent disassemble-recursive-indent)))
-		       ((eq (car-safe (car-safe arg)) 'byte-code)
-			(insert "(<byte code>...)\n")
-			(mapcar ;recurse on list of byte-code objects
-			 '(lambda (obj)
-			    (disassemble-1
-			     obj
-			     (+ indent disassemble-recursive-indent)))
-			 arg))
-		       (t
-			;; really just a constant
-			(let ((print-escape-newlines t))
-			  (prin1 arg (current-buffer))))))
-		)
-	  (insert "\n")))))
-  nil)
-
-;;; disass.el ends here
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el
deleted file mode 100644
index b172e131763..00000000000
--- a/lisp/emacs-lisp/easymenu.el
+++ /dev/null
@@ -1,244 +0,0 @@
-;;; easymenu.el --- support the easymenu interface for defining a menu.
-
-;; Copyright (C) 1994, 1996 Free Software Foundation, Inc.
-
-;; Keywords: emulations
-;; Author: rms
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This is compatible with easymenu.el by Per Abrahamsen
-;; but it is much simpler as it doesn't try to support other Emacs versions.
-;; The code was mostly derived from lmenu.el.
-
-;;; Code:
-
-;;;###autoload
-(defmacro easy-menu-define (symbol maps doc menu)
-  "Define a menu bar submenu in maps MAPS, according to MENU.
-The menu keymap is stored in symbol SYMBOL, both as its value
-and as its function definition.   DOC is used as the doc string for SYMBOL.
-
-The first element of MENU must be a string.  It is the menu bar item name.
-The rest of the elements are menu items.
-
-A menu item is usually a vector of three elements:  [NAME CALLBACK ENABLE]
-
-NAME is a string--the menu item name.
-
-CALLBACK is a command to run when the item is chosen,
-or a list to evaluate when the item is chosen.
-
-ENABLE is an expression; the item is enabled for selection
-whenever this expression's value is non-nil.
-
-Alternatively, a menu item may have the form: 
-
-   [ NAME CALLBACK [ KEYWORD ARG ] ... ]
-
-Where KEYWORD is one of the symbol defined below.
-
-   :keys KEYS
-
-KEYS is a string; a complex keyboard equivalent to this menu item.
-This is normally not needed because keyboard equivalents are usually
-computed automatically.
-
-   :active ENABLE
-
-ENABLE is an expression; the item is enabled for selection
-whenever this expression's value is non-nil.
-
-   :suffix NAME
-
-NAME is a string; the name of an argument to CALLBACK.
-
-   :style STYLE
-   
-STYLE is a symbol describing the type of menu item.  The following are
-defined:  
-
-toggle: A checkbox.
-        Prepend the name with '(*) ' or '( ) ' depending on if selected or not.
-radio: A radio button.
-       Prepend the name with '[X] ' or '[ ] ' depending on if selected or not.
-nil: An ordinary menu item.
-
-   :selected SELECTED
-
-SELECTED is an expression; the checkbox or radio button is selected
-whenever this expression's value is non-nil.
-
-A menu item can be a string.  Then that string appears in the menu as
-unselectable text.  A string consisting solely of hyphens is displayed
-as a solid horizontal line.
-
-A menu item can be a list.  It is treated as a submenu.
-The first element should be the submenu name.  That's used as the
-menu item in the top-level menu.  The cdr of the submenu list
-is a list of menu items, as above."
-  (` (progn
-       (defvar (, symbol) nil (, doc))
-       (easy-menu-do-define (quote (, symbol)) (, maps) (, doc) (, menu)))))
-
-;;;###autoload
-(defun easy-menu-do-define (symbol maps doc menu)
-  ;; We can't do anything that might differ between Emacs dialects in
-  ;; `easy-menu-define' in order to make byte compiled files
-  ;; compatible.  Therefore everything interesting is done in this
-  ;; function. 
-  (set symbol (easy-menu-create-keymaps (car menu) (cdr menu)))
-  (fset symbol (` (lambda (event) (, doc) (interactive "@e")
-		    (x-popup-menu event (, symbol)))))
-  (mapcar (function (lambda (map) 
-	    (define-key map (vector 'menu-bar (intern (car menu)))
-	      (cons (car menu) (symbol-value symbol)))))
-	  (if (keymapp maps) (list maps) maps)))
-
-(defvar easy-menu-item-count 0)
-
-;; Return a menu keymap corresponding to a Lucid-style menu list
-;; MENU-ITEMS, and with name MENU-NAME.
-;;;###autoload
-(defun easy-menu-create-keymaps (menu-name menu-items)
-  (let ((menu (make-sparse-keymap menu-name)) old-items have-buttons)
-    ;; Process items in reverse order,
-    ;; since the define-key loop reverses them again.
-    (setq menu-items (reverse menu-items))
-    (while menu-items
-      (let* ((item (car menu-items))
-	     (callback (if (vectorp item) (aref item 1)))
-	     (not-button t)
-	     command enabler item-string name)
-	(cond ((stringp item)
-	       (setq command nil)
-	       (setq item-string (if (string-match "^-+$" item) "" item)))
-	      ((consp item)
-	       (setq command (easy-menu-create-keymaps (car item) (cdr item)))
-	       (setq name (setq item-string (car item))))
-	      ((vectorp item)
-	       (setq command (make-symbol (format "menu-function-%d"
-						  easy-menu-item-count)))
-	       (setq easy-menu-item-count (1+ easy-menu-item-count))
-	       (setq name (setq item-string (aref item 0)))
-	       (let ((keyword (aref item 2)))
-		 (if (and (symbolp keyword)
-			  (= ?: (aref (symbol-name keyword) 0)))
-		     (let ((count 2)
-			   style selected active keys
-			   arg)
-		       (while (> (length item) count)
-			 (setq keyword (aref item count))
-			 (setq arg (aref item (1+ count)))
-			 (setq count (+ 2 count))
-			 (cond ((eq keyword ':keys)
-				(setq keys arg))
-			       ((eq keyword ':active)
-				(setq active arg))
-			       ((eq keyword ':suffix)
-				(setq item-string
-				      (concat item-string " " arg)))
-			       ((eq keyword ':style)
-				(setq style arg))
-			       ((eq keyword ':selected)
-				(setq selected arg))))
-		       (if keys
-			   (setq item-string
-				 (concat item-string "  (" keys ")")))
-		       (if (and selected
-				(or (eq style 'radio) (eq style 'toggle)))
-			   ;; Simulate checkboxes and radio buttons.
-			   (progn
-			     (setq item-string
-				   (concat
-				    (if (eval selected)
-					(if (eq style 'radio) "(*) " "[X] ")
-				      (if (eq style 'radio) "( ) " "[ ] "))
-				    item-string))
-			     (put command 'menu-enable
-				  (list 'easy-menu-update-button
-					item-string
-					(if (eq style 'radio) ?* ?X)
-					selected
-					(or active t)))
-			     (setq not-button nil
-				   active     nil
-				   have-buttons t)
-			     (while old-items ; Fix items aleady defined.
-			       (setcar (car old-items)
-				       (concat "    " (car (car old-items))))
-			       (setq old-items (cdr old-items)))))
-		       (if active (put command 'menu-enable active)))
-		   (put command 'menu-enable keyword)))
-	       (if (symbolp callback)
-		   (fset command callback)
-		 (fset command (list 'lambda () '(interactive) callback)))
-	       (put command 'menu-alias t)))
-	(if (null command)
-	    ;; Handle inactive strings specially--allow any number
-	    ;; of identical ones.
-	    (setcdr menu (cons (list nil item-string) (cdr menu)))
-	  (if (and not-button have-buttons)
-	      (setq item-string (concat "    " item-string)))
-	  (setq command (cons item-string command))
-	  (if (not have-buttons)	; Save all items so that we can fix
-	      (setq old-items (cons command old-items))) ; if we have buttons.
-	  (if name (define-key menu (vector (intern name)) command))))
-      (setq menu-items (cdr menu-items)))
-    menu))
-
-(defun easy-menu-update-button (item ch selected active)
-  "Used as menu-enable property to update buttons.
-A call to this function is used as the menu-enable property for buttons.
-ITEM is the item-string into wich CH or ` ' is inserted depending on if
-SELECTED is true or not. The menu entry in enabled iff ACTIVE is true."
-  (let ((new (if selected ch ? ))
-	(old (aref item 1)))
-    (if (eq new old)
-	;; No change, just use the active value.
-	active
-      ;; It has changed.  Update the entry.
-      (aset item 1 new)
-      ;; If the entry is active, make sure the menu gets updated by
-      ;; returning a different value than last time to cheat the cache. 
-      (and active
-	   (random)))))
-
-(defun easy-menu-change (path name items)
-  "Change menu found at PATH as item NAME to contain ITEMS.
-PATH is a list of strings for locating the menu containing NAME in the
-menu bar.  ITEMS is a list of menu items, as in `easy-menu-define'.
-These items entirely replace the previous items in that map.
-
-Call this from `menu-bar-update-hook' to implement dynamic menus."
-  (let ((map (key-binding (apply 'vector
-				 'menu-bar
-				 (mapcar 'intern (append path (list name)))))))
-    (if (keymapp map)
-	(setcdr map (cdr (easy-menu-create-keymaps name items)))
-      (error "Malformed menu in `easy-menu-change'"))))
-
-(defun easy-menu-remove (menu))
-
-(defun easy-menu-add (menu &optional map))
-
-(provide 'easymenu)
-
-;;; easymenu.el ends here
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
deleted file mode 100644
index f6831f6f29d..00000000000
--- a/lisp/emacs-lisp/edebug.el
+++ /dev/null
@@ -1,4515 +0,0 @@
-;;; edebug.el --- a source-level debugger for Emacs Lisp
-
-;; Copyright (C) 1988,'89,'90,'91,'92,'93,'94,'95 Free Software Foundation, Inc
-
-;; Author: Daniel LaLiberte <liberte@cs.uiuc.edu>
-;; Keywords: lisp, tools, maint
-
-;; LCD Archive Entry:
-;; edebug|Daniel LaLiberte|liberte@cs.uiuc.edu
-;; |A source level debugger for Emacs Lisp.
-;; |$Date: 1996/11/09 21:48:07 $|$Revision: 3.12 $|~/modes/edebug.el|
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This minor mode allows programmers to step through Emacs Lisp
-;; source code while executing functions.  You can also set
-;; breakpoints, trace (stopping at each expression), evaluate
-;; expressions as if outside Edebug, reevaluate and display a list of
-;; expressions, trap errors normally caught by debug, and display a
-;; debug style backtrace.
-
-;;; Installation
-;; =============
-
-;; Put edebug.el in some directory in your load-path and
-;; byte-compile it.  Also read the beginning of edebug-epoch.el, 
-;; cl-specs.el, and edebug-cl-read.el if they apply to you.
-
-;; Unless you are using Emacs 19 which is already set up to use Edebug,
-;; put the following forms in your .emacs file.
-;; (define-key emacs-lisp-mode-map "\C-xx" 'edebug-eval-top-level-form)
-;; (autoload 'edebug-eval-top-level-form "edebug")
-
-;; If you wish to change the default edebug global command prefix, change:
-;; (setq edebug-global-prefix "\C-xX")
-
-;; Other options, are described in the manual.
-
-;; In previous versions of Edebug, users were directed to set
-;; `debugger' to `edebug-debug'.  This is no longer necessary
-;; since Edebug automatically sets it whenever Edebug is active.
-
-;;; Minimal Instructions
-;; =====================
-
-;; First evaluate a defun with C-xx, then run the function.  Step
-;; through the code with SPC, mark breakpoints with b, go until a
-;; breakpoint is reached with g, and quit execution with q.  Use the
-;; "?" command in edebug to describe other commands.  See edebug.tex
-;; or the Emacs 19 Lisp Reference Manual for more instructions.
-
-;; Send me your enhancements, ideas, bugs, or fixes.
-;; For bugs, you can call edebug-submit-bug-report if you have reporter.el.
-;; There is an edebug mailing list if you want to keep up
-;; with the latest developments. Requests to: edebug-request@cs.uiuc.edu
-
-;; Daniel LaLiberte   217-398-4114
-;; University of Illinois, Urbana-Champaign
-;; Department of Computer Science
-;; 1304 W Springfield
-;; Urbana, IL  61801
-
-;; uiucdcs!liberte
-;; liberte@cs.uiuc.edu
-
-;; For the early revision history, see edebug-history.
-
-;;; Code:
-
-(defconst edebug-version
-  (let ((raw-version "$Revision: 3.12 $"))
-    (substring raw-version (string-match "[0-9.]*" raw-version)
-	       (match-end 0))))
-     
-(require 'backquote)
-
-;; Emacs 18 doesn't have defalias.
-(eval-and-compile
-  (or (fboundp 'defalias) (fset 'defalias 'fset)))
-
-
-;;; Bug reporting
-
-(defconst edebug-maintainer-address "liberte@cs.uiuc.edu")
-
-(defun edebug-submit-bug-report ()
-  "Submit, via mail, a bug report on edebug."
-  (interactive)
-  (require 'reporter)
-  (and (y-or-n-p "Do you really want to submit a report on edebug? ")
-       (reporter-submit-bug-report
-         edebug-maintainer-address
-         (concat "edebug.el " edebug-version)
-         (list 'edebug-setup-hook
-               'edebug-all-defs
-               'edebug-all-forms
-               'edebug-eval-macro-args
-               'edebug-stop-before-symbols
-               'edebug-save-windows
-               'edebug-save-displayed-buffer-points
-               'edebug-initial-mode
-               'edebug-trace
-               'edebug-test-coverage
-               'edebug-continue-kbd-macro
-               'edebug-print-length
-               'edebug-print-level
-               'edebug-print-circle
-	       ))))
-
-;;; Options
-
-(defvar edebug-setup-hook nil
-  "*Functions to call before edebug is used.
-Each time it is set to a new value, Edebug will call those functions
-once and then `edebug-setup-hook' is reset to nil.  You could use this
-to load up Edebug specifications associated with a package you are
-using but only when you also use Edebug.")
-
-(defvar edebug-all-defs nil
-  "*If non-nil, evaluation of any defining forms will instrument for Edebug.
-This applies to `eval-defun', `eval-region', `eval-buffer', and
-`eval-current-buffer'.  `eval-region' is also called by
-`eval-last-sexp', and `eval-print-last-sexp'.
-
-You can use the command `edebug-all-defs' to toggle the value of this
-variable.  You may wish to make it local to each buffer with
-\(make-local-variable 'edebug-all-defs) in your
-`emacs-lisp-mode-hook'.")
-
-(defvar edebug-all-forms nil
-  "*Non-nil evaluation of all forms will instrument for Edebug.
-This doesn't apply to loading or evaluations in the minibuffer.
-Use the command `edebug-all-forms' to toggle the value of this option.")
-
-(defvar edebug-eval-macro-args nil
-  "*Non-nil means all macro call arguments may be evaluated.  
-If this variable is nil, the default, Edebug will *not* wrap
-macro call arguments as if they will be evaluated.  
-For each macro, a `edebug-form-spec' overrides this option.
-So to specify exceptions for macros that have some arguments evaluated
-and some not, you should specify an `edebug-form-spec'.
-
-This option is going away soon.")
-
-(defvar edebug-stop-before-symbols nil
-  "*Non-nil causes Edebug to stop before symbols as well as after.  
-In any case, a breakpoint or interrupt may stop before a symbol.
-
-This option is going away soon.")
-
-(defvar edebug-save-windows t
-  "*If non-nil, Edebug saves and restores the window configuration.
-That takes some time, so if your program does not care what happens to
-the window configurations, it is better to set this variable to nil.
-
-If the value is a list, only the listed windows are saved and
-restored.  
-
-`edebug-toggle-save-windows' may be used to change this variable.")
-
-(defvar edebug-save-displayed-buffer-points nil
-  "*If non-nil, save and restore point in all displayed buffers.
-
-Saving and restoring point in other buffers is necessary if you are
-debugging code that changes the point of a buffer which is displayed
-in a non-selected window.  If Edebug or the user then selects the
-window, the buffer's point will be changed to the window's point.
-
-Saving and restoring point in all buffers is expensive, since it
-requires selecting each window twice, so enable this only if you need
-it.")
-
-(defvar edebug-initial-mode 'step
-  "*Initial execution mode for Edebug, if non-nil.  If this variable
-is non-@code{nil}, it specifies the initial execution mode for Edebug
-when it is first activated.  Possible values are step, next, go,
-Go-nonstop, trace, Trace-fast, continue, and Continue-fast.")
-
-(defvar edebug-trace nil
-  "*Non-nil means display a trace of function entry and exit.
-Tracing output is displayed in a buffer named `*edebug-trace*', one
-function entry or exit per line, indented by the recursion level.  
-
-You can customize by replacing functions `edebug-print-trace-before'
-and `edebug-print-trace-after'.")
-
-(defvar edebug-test-coverage nil
-  "*If non-nil, Edebug tests coverage of all expressions debugged.
-This is done by comparing the result of each expression
-with the previous result. Coverage is considered OK if two different
-results are found.
-
-Use `edebug-display-freq-count' to display the frequency count and
-coverage information for a definition.")
-
-(defvar edebug-continue-kbd-macro nil
-  "*If non-nil, continue defining or executing any keyboard macro.
-Use this with caution since it is not debugged.")
-
-
-(defvar edebug-print-length 50
-  "*Default value of `print-length' to use while printing results in Edebug.")
-(defvar edebug-print-level 50
-  "*Default value of `print-level' to use while printing results in Edebug.")
-(defvar edebug-print-circle t
-  "*Default value of `print-circle' to use while printing results in Edebug.")
-
-(defvar edebug-unwrap-results nil
-  "*Non-nil if Edebug should unwrap results of expressions.
-This is useful when debugging macros where the results of expressions
-are instrumented expressions.  But don't do this when results might be
-circular or an infinite loop will result.")
-
-(defvar edebug-on-error t
-  "*Value bound to `debug-on-error' while Edebug is active.
-
-If `debug-on-error' is non-nil, that value is still used.
-
-If the value is a list of signal names, Edebug will stop when any of
-these errors are signaled from Lisp code whether or not the signal is
-handled by a `condition-case'.  This option is useful for debugging
-signals that *are* handled since they would otherwise be missed.
-After execution is resumed, the error is signaled again.")
-
-(defvar edebug-on-quit t
-  "*Value bound to `debug-on-quit' while Edebug is active.")
-
-(defvar edebug-global-break-condition nil
-  "*If non-nil, an expression to test for at every stop point.
-If the result is non-nil, then break.  Errors are ignored.")
-
-;;; Form spec utilities.
-
-;;;###autoload
-(defmacro def-edebug-spec (symbol spec)
-  "Set the edebug-form-spec property of SYMBOL according to SPEC.
-Both SYMBOL and SPEC are unevaluated. The SPEC can be 0, t, a symbol
-\(naming a function), or a list."
-  (` (put (quote (, symbol)) 'edebug-form-spec (quote (, spec)))))
-
-(defmacro def-edebug-form-spec (symbol spec-form)
-  "For compatibility with old version.  Use `def-edebug-spec' instead."
-  (message "Obsolete: use def-edebug-spec instead.")
-  (def-edebug-spec symbol (eval spec-form)))
-
-(defun get-edebug-spec (symbol)
-  ;; Get the spec of symbol resolving all indirection.
-  (let ((edebug-form-spec (get symbol 'edebug-form-spec))
-	indirect)
-    (while (and (symbolp edebug-form-spec)
-		(setq indirect (get edebug-form-spec 'edebug-form-spec)))
-      ;; (edebug-trace "indirection: %s" edebug-form-spec)
-      (setq edebug-form-spec indirect))
-    edebug-form-spec
-    ))
-
-;;; Utilities
-
-;; Define edebug-gensym - from old cl.el
-(defvar edebug-gensym-index 0
-  "Integer used by `edebug-gensym' to produce new names.")
-
-(defun edebug-gensym (&optional prefix)
-  "Generate a fresh uninterned symbol.
-There is an  optional argument, PREFIX.  PREFIX is the
-string that begins the new name. Most people take just the default,
-except when debugging needs suggest otherwise."
-  (if (null prefix)
-      (setq prefix "G"))
-  (let ((newsymbol nil)
-        (newname   ""))
-    (while (not newsymbol)
-      (setq newname (concat prefix (int-to-string edebug-gensym-index)))
-      (setq edebug-gensym-index (+ edebug-gensym-index 1))
-      (if (not (intern-soft newname))
-          (setq newsymbol (make-symbol newname))))
-    newsymbol))
-
-;; Only used by CL-like code.
-(defun edebug-keywordp (object)
-  "Return t if OBJECT is a keyword.
-A keyword is a symbol that starts with `:'."
-  (and (symbolp object)
-       (= ?: (aref (symbol-name object) 0))))
-
-(defun edebug-lambda-list-keywordp (object)
-  "Return t if OBJECT is a lambda list keyword.
-A lambda list keyword is a symbol that starts with `&'."
-  (and (symbolp object)
-       (= ?& (aref (symbol-name object) 0))))
-
-
-(defun edebug-last-sexp ()
-  ;; Return the last sexp before point in current buffer.
-  ;; Assumes Emacs Lisp syntax is active.
-  (car
-   (read-from-string
-    (buffer-substring
-     (save-excursion
-       (forward-sexp -1)
-       (point))
-     (point)))))
-
-(defun edebug-window-list ()
-  "Return a list of windows, in order of `next-window'."
-  ;; This doesn't work for epoch.
-  (let* ((first-window (selected-window))
-	 (window-list (list first-window))
-	 (next (next-window first-window)))
-    (while (not (eq next first-window))
-      (setq window-list (cons next window-list))
-      (setq next (next-window next)))
-    (nreverse window-list)))
-
-(defun edebug-window-live-p (window)
-  "Return non-nil if WINDOW is visible."
-  (let* ((first-window (selected-window))
-	 (next (next-window first-window t)))
-    (while (not (or (eq next window) 
-		    (eq next first-window)))
-      (setq next (next-window next t)))
-    (eq next window)))
-
-;; Not used.
-'(defun edebug-two-window-p ()
-  "Return t if there are two windows."
-  (and (not (one-window-p))
-       (eq (selected-window)
-	   (next-window (next-window (selected-window))))))
-
-(defsubst edebug-lookup-function (object)
-  (while (and (symbolp object) (fboundp object))
-    (setq object (symbol-function object)))
-  object)
-  
-(defun edebug-macrop (object)
-  "Return the macro named by OBJECT, or nil if it is not a macro."
-  (setq object (edebug-lookup-function object))
-  (if (and (listp object)
-	   (eq 'macro (car object))
-	   (edebug-functionp (cdr object)))
-      object))
-
-(defun edebug-functionp (object)
-  "Returns the function named by OBJECT, or nil if it is not a function."
-  (setq object (edebug-lookup-function object))
-  (if (or (subrp object)
-	  (byte-code-function-p object)
-	  (and (listp object)
-	       (eq (car object) 'lambda)
-	       (listp (car (cdr object)))))
-      object))
-
-(defun edebug-sort-alist (alist function)
-  ;; Return the ALIST sorted with comparison function FUNCTION.
-  ;; This uses 'sort so the sorting is destructive.
-  (sort alist (function
-	       (lambda (e1 e2)
-		 (funcall function (car e1) (car e2))))))
-
-;;(def-edebug-spec edebug-save-restriction t)
-
-;; Not used.  If it is used, def-edebug-spec must be defined before use.
-'(defmacro edebug-save-restriction (&rest body)
-  "Evaluate BODY while saving the current buffers restriction.
-BODY may change buffer outside of current restriction, unlike
-save-restriction.  BODY may change the current buffer,
-and the restriction will be restored to the original buffer,
-and the current buffer remains current.
-Return the result of the last expression in BODY."
-  (` (let ((edebug:s-r-beg (point-min-marker))
-	   (edebug:s-r-end (point-max-marker)))
-       (unwind-protect
-	   (progn (,@ body))
-	 (save-excursion
-	   (set-buffer (marker-buffer edebug:s-r-beg))
-	   (narrow-to-region edebug:s-r-beg edebug:s-r-end))))))
-
-;;; Display
-
-(defconst edebug-trace-buffer "*edebug-trace*"
-  "Name of the buffer to put trace info in.")
-
-(defun edebug-pop-to-buffer (buffer &optional window)
-  ;; Like pop-to-buffer, but select window where BUFFER was last shown.
-  ;; Select WINDOW if it provided and it still exists.  Otherwise, 
-  ;; if buffer is currently shown in several windows, choose one.
-  ;; Otherwise, find a new window, possibly splitting one.
-  (setq window (if (and (windowp window) (edebug-window-live-p window)
-			(eq (window-buffer window) buffer))
-		   window
-		 (if (eq (window-buffer (selected-window)) buffer)
-		     (selected-window)
-		   (edebug-get-buffer-window buffer))))
-  (if window
-      (select-window window)
-    (if (one-window-p)
-	(split-window))
-    ;;      (message "next window: %s" (next-window)) (sit-for 1)
-    (if (eq (get-buffer-window edebug-trace-buffer) (next-window))
-	;; Don't select trace window
-	nil
-      (select-window (next-window))))
-  (set-window-buffer (selected-window) buffer)
-  (set-window-hscroll (selected-window) 0);; should this be??
-  ;; Selecting the window does not set the buffer until command loop.
-  ;;(set-buffer buffer)
-  )
-
-
-(defun edebug-get-displayed-buffer-points ()
-  ;; Return a list of buffer point pairs, for all displayed buffers.
-  (save-excursion
-    (let* ((first-window (selected-window))
-	   (next (next-window first-window))
-	   (buffer-point-list nil)
-	   buffer)
-      (while (not (eq next first-window))
-	(set-buffer (setq buffer (window-buffer next)))
-	(setq buffer-point-list
-	      (cons (cons buffer (point)) buffer-point-list))
-	(setq next (next-window next)))
-      buffer-point-list)))
-
-
-(defun edebug-set-buffer-points (buffer-points)
-  ;; Restore the buffer-points created by edebug-get-displayed-buffer-points.
-  (let ((current-buffer (current-buffer)))
-    (mapcar (function (lambda (buf-point)
-			(if (buffer-name (car buf-point)) ; still exists
-			    (progn
-			      (set-buffer (car buf-point))
-			      (goto-char (cdr buf-point))))))
-	    buffer-points)
-    (set-buffer current-buffer)))
-
-(defun edebug-current-windows (which-windows)
-  ;; Get either a full window configuration or some window information.
-  (if (listp which-windows)
-      (mapcar (function (lambda (window)
-			  (if (edebug-window-live-p window)
-			      (list window
-				    (window-buffer window)
-				    (window-point window)
-				    (window-start window)
-				    (window-hscroll window)))))
-	      which-windows)
-    (current-window-configuration)))
-
-(defun edebug-set-windows (window-info)
-  ;; Set either a full window configuration or some window information.
-  (if (listp window-info)
-      (mapcar (function 
-	       (lambda (one-window-info)
-		 (if one-window-info
-		     (apply (function 
-			     (lambda (window buffer point start hscroll)
-			       (if (edebug-window-live-p window)
-				   (progn
-				     (set-window-buffer window buffer)
-				     (set-window-point window point)
-				     (set-window-start window start)
-				     (set-window-hscroll window hscroll)))))
-			    one-window-info))))
-	      window-info)
-    (set-window-configuration window-info)))
-
-(defalias 'edebug-get-buffer-window 'get-buffer-window)
-(defalias 'edebug-sit-for 'sit-for)
-(defalias 'edebug-input-pending-p 'input-pending-p)
-
-
-;;; Redefine read and eval functions
-;; read is redefined to maybe instrument forms.
-;; eval-defun is redefined to check edebug-all-forms and edebug-all-defs.
-
-;; Use the Lisp version of eval-region.
-(require 'eval-reg "eval-reg")
-
-;; Save the original read function
-(or (fboundp 'edebug-original-read)
-    (defalias 'edebug-original-read  (symbol-function 'read)))
-
-(defun edebug-read (&optional stream)
-  "Read one Lisp expression as text from STREAM, return as Lisp object.
-If STREAM is nil, use the value of `standard-input' (which see).
-STREAM or the value of `standard-input' may be:
- a buffer (read from point and advance it)
- a marker (read from where it points and advance it)
- a function (call it with no arguments for each character,
-     call it with a char as argument to push a char back)
- a string (takes text from string, starting at the beginning)
- t (read text line using minibuffer and use it).
-
-This version, from Edebug, maybe instruments the expression. But the
-STREAM must be the current buffer to do so.  Whether it instruments is
-also dependent on the values of `edebug-all-defs' and
-`edebug-all-forms'."
-  (or stream (setq stream standard-input))
-  (if (eq stream (current-buffer))
-      (edebug-read-and-maybe-wrap-form)
-    (edebug-original-read stream)))
-
-(or (fboundp 'edebug-original-eval-defun)
-    (defalias 'edebug-original-eval-defun (symbol-function 'eval-defun)))
-
-;; We should somehow arrange to be able to do this
-;; without actually replacing the eval-defun command.
-(defun edebug-eval-defun (edebug-it)
-  "Evaluate the top-level form containing point, or after point.
-
-This version, from Edebug, has the following differences: With a
-prefix argument instrument the code for Edebug.  If `edebug-all-defs' is
-non-nil, then the code is instrumented *unless* there is a prefix
-argument.  If instrumenting, it prints: `Edebug: FUNCTIONNAME'.
-Otherwise, it prints in the minibuffer."
-  (interactive "P")
-  (let* ((edebugging (not (eq (not edebug-it) (not edebug-all-defs))))
-	 (edebug-result)
-	 (form
-	  (let ((edebug-all-forms edebugging)
-		(edebug-all-defs (eq edebug-all-defs (not edebug-it))))
-	    (edebug-read-top-level-form))))
-    (if (and (eq (car form) 'defvar)
-	     (cdr-safe (cdr-safe form)))
-	(setq form (cons 'defconst (cdr form))))
-    (setq edebug-result (eval form))
-    (if (not edebugging)
-	(princ edebug-result)
-      edebug-result)))
-
-
-;;;###autoload
-(defalias 'edebug-defun 'edebug-eval-top-level-form)
-
-;;;###autoload
-(defun edebug-eval-top-level-form ()
-  "Evaluate a top level form, such as a defun or defmacro.
-This is like `eval-defun', but the code is always instrumented for Edebug.
-Print its name in the minibuffer and leave point where it is,
-or if an error occurs, leave point after it with mark at the original point."
-  (interactive)
-  (eval 
-   ;; Bind edebug-all-forms only while reading, not while evalling
-   ;; but this causes problems while edebugging edebug.
-   (let ((edebug-all-forms t)
-	 (edebug-all-defs t))
-     (edebug-read-top-level-form))))
-
-
-(defun edebug-read-top-level-form ()
-  (let ((starting-point (point)))
-    (end-of-defun)
-    (beginning-of-defun)
-    (prog1
-	(edebug-read-and-maybe-wrap-form)
-      ;; Recover point, but only if no error occurred.
-      (goto-char starting-point))))
-
-
-;; Compatibility with old versions.
-(defalias 'edebug-all-defuns 'edebug-all-defs)
-
-(defun edebug-all-defs ()
-  "Toggle edebugging of all definitions."
-  (interactive)
-  (setq edebug-all-defs (not edebug-all-defs))
-  (message "Edebugging all definitions is %s." 
-	   (if edebug-all-defs "on" "off")))
-
-
-(defun edebug-all-forms ()
-  "Toggle edebugging of all forms."
-  (interactive)
-  (setq edebug-all-forms (not edebug-all-forms))
-  (message "Edebugging all forms is %s." 
-	   (if edebug-all-forms "on" "off")))
-
-
-(defun edebug-install-read-eval-functions ()
-  (interactive)
-  ;; Don't install if already installed.
-  (if (eq (symbol-function 'read) 'edebug-read) nil
-    (elisp-eval-region-install)
-    (defalias 'read 'edebug-read)
-    (defalias 'eval-defun 'edebug-eval-defun)))
-
-(defun edebug-uninstall-read-eval-functions ()
-  (interactive)
-  (elisp-eval-region-uninstall)
-  (defalias 'read (symbol-function 'edebug-original-read))
-  (defalias 'eval-defun (symbol-function 'edebug-original-eval-defun)))
-
-
-;;; Edebug internal data
-
-;; The internal data that is needed for edebugging is kept in the
-;; buffer-local variable `edebug-form-data'. 
-
-(make-variable-buffer-local 'edebug-form-data)
-
-(defconst edebug-form-data nil)
-;; A list of entries associating symbols with buffer regions.
-;; This is an automatic buffer local variable.  Each entry looks like:
-;; @code{(@var{symbol} @var{begin-marker} @var{end-marker}).  The markers
-;; are at the beginning and end of an entry level form and @var{symbol} is
-;; a symbol that holds all edebug related information for the form on its
-;; property list.
-
-;; In the future, the symbol will be irrelevant and edebug data will
-;; be stored in the definitions themselves rather than in the property
-;; list of a symbol.
-
-(defun edebug-make-form-data-entry (symbol begin end)
-  (list symbol begin end))
-
-(defsubst edebug-form-data-name (entry)
-  (car entry))
-
-(defsubst edebug-form-data-begin (entry)
-  (nth 1 entry))
-
-(defsubst edebug-form-data-end (entry)
-  (nth 2 entry))
-
-(defsubst edebug-set-form-data-entry (entry name begin end)
-  (setcar entry name);; in case name is changed
-  (set-marker (nth 1 entry) begin)
-  (set-marker (nth 2 entry) end))
-
-(defun edebug-get-form-data-entry (pnt &optional end-point)
-  ;; Find the edebug form data entry which is closest to PNT.
-  ;; If END-POINT is supplied, match must be exact.
-  ;; Return `nil' if none found.
-  (let ((rest edebug-form-data)
-	closest-entry
-	(closest-dist 999999))  ;; need maxint here
-    (while (and rest (< 0 closest-dist))
-      (let* ((entry (car rest))
-	     (begin (edebug-form-data-begin entry))
-	     (dist (- pnt begin)))
-	(setq rest (cdr rest))
-	(if (and (<= 0 dist)
-		 (< dist closest-dist)
-		 (or (not end-point)
-		     (= end-point (edebug-form-data-end entry)))
-		 (<= pnt (edebug-form-data-end entry)))
-	    (setq closest-dist dist
-		  closest-entry entry))))
-    closest-entry))
-
-;; Also need to find all contained entries,
-;; and find an entry given a symbol, which should be just assq.
-
-(defun edebug-form-data-symbol ()
-;; Return the edebug data symbol of the form where point is in.
-;; If point is not inside a edebuggable form, cause error.
-  (or (edebug-form-data-name (edebug-get-form-data-entry (point)))
-      (error "Not inside instrumented form")))
-
-(defun edebug-make-top-form-data-entry (new-entry)
-  ;; Make NEW-ENTRY the first element in the `edebug-form-data' list.
-  (edebug-clear-form-data-entry new-entry)
-  (setq edebug-form-data (cons new-entry edebug-form-data)))
-
-(defun edebug-clear-form-data-entry (entry)
-;; If non-nil, clear ENTRY out of the form data.  
-;; Maybe clear the markers and delete the symbol's edebug property?
-  (if entry
-      (progn
-	;; Instead of this, we could just find all contained forms. 
-	;; (put (car entry) 'edebug nil)   ; 
-	;; (mapcar 'edebug-clear-form-data-entry   ; dangerous
-	;;   (get (car entry) 'edebug-dependents))
-	;; (set-marker (nth 1 entry) nil)
-	;; (set-marker (nth 2 entry) nil)
-	(setq edebug-form-data (delq entry edebug-form-data)))))
-
-;;; Parser utilities
-
-(defun edebug-syntax-error (&rest args)
-  ;; Signal an invalid-read-syntax with ARGS.
-  (signal 'invalid-read-syntax args))
-
-
-(defconst edebug-read-syntax-table
-  ;; Lookup table for significant characters indicating the class of the
-  ;; token that follows.  This is not a \"real\" syntax table.
-  (let ((table (make-vector 256 'symbol))
-	(i 0))
-    (while (< i ?!)
-      (aset table i 'space)
-      (setq i (1+ i)))
-    (aset table ?\( 'lparen)
-    (aset table ?\) 'rparen)
-    (aset table ?\' 'quote)
-    (aset table ?\` 'backquote)
-    (aset table ?\, 'comma)
-    (aset table ?\" 'string)
-    (aset table ?\? 'char)
-    (aset table ?\[ 'lbracket)
-    (aset table ?\] 'rbracket)
-    (aset table ?\. 'dot)
-    (aset table ?\# 'hash)
-    ;; We treat numbers as symbols, because of confusion with -, -1, and 1-.
-    ;; We don't care about any other chars since they won't be seen.
-    table))
-
-(defun edebug-next-token-class ()
-  ;; Move to the next token and return its class.  We only care about
-  ;; lparen, rparen, dot, quote, backquote, comma, string, char, vector,
-  ;; or symbol.
-  (edebug-skip-whitespace)
-  (aref edebug-read-syntax-table (following-char)))
-
-
-(defun edebug-skip-whitespace ()
-  ;; Leave point before the next token, skipping white space and comments.
-  (skip-chars-forward " \t\r\n\f")
-  (while (= (following-char) ?\;)
-    ;; \r is counted as a comment terminator to support selective display.
-    (skip-chars-forward "^\n\r")  ; skip the comment
-    (skip-chars-forward " \t\r\n\f")))
-
-
-;; Mostly obsolete reader; still used in one case.
-
-(defun edebug-read-sexp ()
-  ;; Read one sexp from the current buffer starting at point.
-  ;; Leave point immediately after it.  A sexp can be a list or atom.
-  ;; An atom is a symbol (or number), character, string, or vector.
-  ;; This works for reading anything legitimate, but it
-  ;; is gummed up by parser inconsistencies (bugs?)
-  (let ((class (edebug-next-token-class)))
-    (cond
-     ;; read goes one too far if a (possibly quoted) string or symbol
-     ;; is immediately followed by non-whitespace.
-     ((eq class 'symbol) (edebug-original-read (current-buffer)))
-     ((eq class 'string) (edebug-original-read (current-buffer)))
-     ((eq class 'quote) (forward-char 1)
-      (list 'quote (edebug-read-sexp)))
-     ((eq class 'backquote)
-      (list '\` (edebug-read-sexp)))
-     ((eq class 'comma)
-      (list '\, (edebug-read-sexp)))
-     (t ; anything else, just read it.
-      (edebug-original-read (current-buffer))))))
-
-;;; Offsets for reader
-
-;; Define a structure to represent offset positions of expressions.
-;; Each offset structure looks like: (before . after) for constituents,
-;; or for structures that have elements: (before <subexpressions> . after)
-;; where the <subexpressions> are the offset structures for subexpressions
-;; including the head of a list.
-(defconst edebug-offsets nil)
-
-;; Stack of offset structures in reverse order of the nesting.
-;; This is used to get back to previous levels.
-(defconst edebug-offsets-stack nil)
-(defconst edebug-current-offset nil) ; Top of the stack, for convenience.
-
-;; We must store whether we just read a list with a dotted form that
-;; is itself a list.  This structure will be condensed, so the offsets
-;; must also be condensed.
-(defconst edebug-read-dotted-list nil)
-
-(defsubst edebug-initialize-offsets ()
-  ;; Reinitialize offset recording.
-  (setq edebug-current-offset nil))
-
-(defun edebug-store-before-offset (point)
-  ;; Add a new offset pair with POINT as the before offset.
-  (let ((new-offset (list point)))
-    (if edebug-current-offset
-	(setcdr edebug-current-offset
-		(cons new-offset (cdr edebug-current-offset)))
-      ;; Otherwise, we are at the top level, so initialize.
-      (setq edebug-offsets new-offset
-	    edebug-offsets-stack nil
-	    edebug-read-dotted-list nil))
-    ;; Cons the new offset to the front of the stack.
-    (setq edebug-offsets-stack (cons new-offset edebug-offsets-stack)
-	  edebug-current-offset new-offset)
-    ))
-
-(defun edebug-store-after-offset (point)
-  ;; Finalize the current offset struct by reversing it and
-  ;; store POINT as the after offset.
-  (if (not edebug-read-dotted-list)
-      ;; Just reverse the offsets of all subexpressions.
-      (setcdr edebug-current-offset (nreverse (cdr edebug-current-offset)))
-
-    ;; We just read a list after a dot, which will be abbreviated out.
-    (setq edebug-read-dotted-list nil)
-    ;; Drop the corresponding offset pair.
-    ;; That is, nconc the reverse of the rest of the offsets 
-    ;; with the cdr of last offset.
-    (setcdr edebug-current-offset
-	    (nconc (nreverse (cdr (cdr edebug-current-offset)))
-		   (cdr (car (cdr edebug-current-offset))))))
-
-  ;; Now append the point using nconc.
-  (setq edebug-current-offset (nconc edebug-current-offset point))
-  ;; Pop the stack.
-  (setq edebug-offsets-stack (cdr edebug-offsets-stack)
-	edebug-current-offset (car edebug-offsets-stack)))
-
-(defun edebug-ignore-offset ()
-  ;; Ignore the last created offset pair.
-  (setcdr edebug-current-offset (cdr (cdr edebug-current-offset))))
-
-(def-edebug-spec edebug-storing-offsets (form body))
-(put 'edebug-storing-offsets 'lisp-indent-hook 1)
-
-(defmacro edebug-storing-offsets (point &rest body)
-  (` (unwind-protect
-	 (progn 
-	   (edebug-store-before-offset (, point))
-	   (,@ body)) 
-       (edebug-store-after-offset (point)))))
-
-
-;;; Reader for Emacs Lisp.
-
-;; Uses edebug-next-token-class (and edebug-skip-whitespace) above.
-
-(defconst edebug-read-alist
-  '((symbol . edebug-read-symbol)
-    (lparen . edebug-read-list)
-    (string . edebug-read-string)
-    (quote . edebug-read-quote)
-    (backquote . edebug-read-backquote)
-    (comma . edebug-read-comma)
-    (lbracket . edebug-read-vector)
-    (hash . edebug-read-function)
-    ))
-
-(defun edebug-read-storing-offsets (stream)
-  (let ((class (edebug-next-token-class))
-	func
-	edebug-read-dotted-list) ; see edebug-store-after-offset
-    (edebug-storing-offsets (point)
-      (if (setq func (assq class edebug-read-alist))
-	  (funcall (cdr func) stream)
-	;; anything else, just read it.
-	(edebug-original-read stream))
-      )))
-
-(defun edebug-read-symbol (stream)
-  (edebug-original-read stream))
-
-(defun edebug-read-string (stream)
-  (edebug-original-read stream))
-
-(defun edebug-read-quote (stream)
-  ;; Turn 'thing into (quote thing)
-  (forward-char 1)
-  (list
-   (edebug-storing-offsets (point)  'quote)
-   (edebug-read-storing-offsets stream)))
-
-(defun edebug-read-backquote (stream)
-  ;; Turn `thing into (\` thing)
-  (let ((opoint (point)))
-    (forward-char 1)
-    ;; Generate the same structure of offsets we would have
-    ;; if the resulting list appeared verbatim in the input text.
-    (edebug-storing-offsets opoint
-      (list
-       (edebug-storing-offsets opoint  '\`)
-       (edebug-read-storing-offsets stream)))))
-
-(defvar edebug-read-backquote-new nil
-  "Non-nil if reading the inside of a new-style backquote with no parens around it.
-Value of nil means reading the inside of an old-style backquote construct
-which is surrounded by an extra set of parentheses.
-This controls how we read comma constructs.")
-
-(defun edebug-read-comma (stream)
-  ;; Turn ,thing into (\, thing).  Handle ,@ and ,. also.
-  (let ((opoint (point)))
-    (forward-char 1)
-    (let ((symbol '\,))
-      (cond ((eq (following-char) ?\.)
-	     (setq symbol '\,\.)
-	     (forward-char 1))
-	    ((eq (following-char) ?\@)
-	     (setq symbol '\,@)
-	     (forward-char 1)))
-      ;; Generate the same structure of offsets we would have
-      ;; if the resulting list appeared verbatim in the input text.
-      (if edebug-read-backquote-new
-	  (list
-	   (edebug-storing-offsets opoint symbol)
-	   (edebug-read-storing-offsets stream))
-	(edebug-storing-offsets opoint symbol)))))
-
-(defun edebug-read-function (stream)
-  ;; Turn #'thing into (function thing)
-  (forward-char 1)
-  (if (/= ?\' (following-char)) (edebug-syntax-error "Bad char"))
-  (forward-char 1)
-  (list 
-   (edebug-storing-offsets (point)  
-     (if (featurep 'cl) 'function* 'function))
-   (edebug-read-storing-offsets stream)))
-
-(defun edebug-read-list (stream)
-  (forward-char 1)			; skip \(
-  (prog1 
-      (let ((elements))
-	(while (not (memq (edebug-next-token-class) '(rparen dot)))
-	  (if (eq (edebug-next-token-class) 'backquote)
-	      (let ((edebug-read-backquote-new (not (null elements)))
-		    (opoint (point)))
-		(if edebug-read-backquote-new
-		    (setq elements (cons (edebug-read-backquote stream) elements))
-		  (forward-char 1)	; Skip backquote.
-		  ;; Call edebug-storing-offsets here so that we
-		  ;; produce the same offsets we would have had
-		  ;; if the backquote were an ordinary symbol.
-		  (setq elements (cons (edebug-storing-offsets opoint '\`)
-				       elements))))
-	    (setq elements (cons (edebug-read-storing-offsets stream) elements))))
-	(setq elements (nreverse elements))
-	(if (eq 'dot (edebug-next-token-class))
-	    (let (dotted-form)
-	      (forward-char 1)		; skip \.
-	      (setq dotted-form (edebug-read-storing-offsets stream))
-		    elements (nconc elements dotted-form)
-	      (if (not (eq (edebug-next-token-class) 'rparen))
-		  (edebug-syntax-error "Expected `)'"))
-	      (setq edebug-read-dotted-list (listp dotted-form))
-	      ))
-	elements)
-    (forward-char 1)			; skip \)
-    ))
-
-(defun edebug-read-vector (stream)
-  (forward-char 1)			; skip \[
-  (prog1 
-      (let ((elements))
-	(while (not (eq 'rbracket (edebug-next-token-class)))
-	  (setq elements (cons (edebug-read-storing-offsets stream) elements)))
-	(apply 'vector (nreverse elements)))
-    (forward-char 1)			; skip \]
-    ))
-
-;;; Cursors for traversal of list and vector elements with offsets.
-
-(defvar edebug-dotted-spec nil)
-
-(defun edebug-new-cursor (expressions offsets)
-  ;; Return a new cursor for EXPRESSIONS with OFFSETS.
-  (if (vectorp expressions) 
-      (setq expressions (append expressions nil)))
-  (cons expressions offsets))
-
-(defsubst edebug-set-cursor (cursor expressions offsets)
-  ;; Set the CURSOR's EXPRESSIONS and OFFSETS to the given.
-  ;; Return the cursor.
-  (setcar cursor expressions)
-  (setcdr cursor offsets)
-  cursor)
-
-'(defun edebug-copy-cursor (cursor)
-  ;; Copy the cursor using the same object and offsets.
-  (cons (car cursor) (cdr cursor)))
-
-(defsubst edebug-cursor-expressions (cursor)
-  (car cursor))
-(defsubst edebug-cursor-offsets (cursor)
-  (cdr cursor))
-
-(defsubst edebug-empty-cursor (cursor)
-  ;; Return non-nil if CURSOR is empty - meaning no more elements.
-  (null (car cursor)))
-
-(defsubst edebug-top-element (cursor)
-  ;; Return the top element at the cursor.
-  ;; Assumes not empty.
-  (car (car cursor)))
-
-(defun edebug-top-element-required (cursor &rest error)
-  ;; Check if a dotted form is required.
-  (if edebug-dotted-spec (edebug-no-match cursor "Dot expected."))
-  ;; Check if there is at least one more argument.
-  (if (edebug-empty-cursor cursor) (apply 'edebug-no-match cursor error))
-  ;; Return that top element.
-  (edebug-top-element cursor))
-
-(defsubst edebug-top-offset (cursor)
-  ;; Return the top offset pair corresponding to the top element.
-  (car (cdr cursor)))
-
-(defun edebug-move-cursor (cursor)
-  ;; Advance and return the cursor to the next element and offset.
-  ;; throw no-match if empty before moving.
-  ;; This is a violation of the cursor encapsulation, but
-  ;; there is plenty of that going on while matching.
-  ;; The following test should always fail.
-  (if (edebug-empty-cursor cursor) 
-      (edebug-no-match cursor "Not enough arguments."))
-  (setcar cursor (cdr (car cursor)))
-  (setcdr cursor (cdr (cdr cursor)))
-  cursor)
-
-
-(defun edebug-before-offset (cursor)
-  ;; Return the before offset of the cursor.
-  ;; If there is nothing left in the offsets,
-  ;; return one less than the offset itself, 
-  ;; which is the after offset for a list.
-  (let ((offset (edebug-cursor-offsets cursor)))
-    (if (consp offset)
-	(car (car offset))
-      (1- offset))))
-
-(defun edebug-after-offset (cursor)
-  ;; Return the after offset of the cursor object.
-  (let ((offset (edebug-top-offset cursor)))
-    (while (consp offset)
-      (setq offset (cdr offset)))
-    offset))
-
-;;; The Parser
-
-;; The top level function for parsing forms is
-;; edebug-read-and-maybe-wrap-form; it calls all the rest.  It checks the
-;; syntax a bit and leaves point at any error it finds, but otherwise
-;; should appear to work like eval-defun.
-
-;; The basic plan is to surround each expression with a call to
-;; the edebug debugger together with indexes into a table of positions of
-;; all expressions.  Thus an expression "exp" becomes:
-
-;; (edebug-after (edebug-before 1) 2 exp)
-
-;; When this is evaluated, first point is moved to the beginning of
-;; exp at offset 1 of the current function.  The expression is
-;; evaluated, which may cause more edebug calls, and then point is
-;; moved to offset 2 after the end of exp.
-
-;; The highest level expressions of the function are wrapped in a call to
-;; edebug-enter, which supplies the function name and the actual
-;; arguments to the function.  See functions edebug-enter, edebug-before,
-;; and edebug-after for more details.
-
-;; Dynamically bound vars, left unbound, but globally declared.
-;; This is to quiet the byte compiler.
-
-;; Window data of the highest definition being wrapped.
-;; This data is shared by all embedded definitions.
-(defvar edebug-top-window-data)
-
-(defvar edebug-&optional)
-(defvar edebug-&rest)
-(defvar edebug-gate nil) ;; whether no-match forces an error.
-
-(defconst edebug-def-name nil) ; name of definition, used by interactive-form
-(defconst edebug-old-def-name nil) ; previous name of containing definition.
-
-(defconst edebug-error-point nil)
-(defconst edebug-best-error nil)
-
-
-(defun edebug-read-and-maybe-wrap-form ()
-  ;; Read a form and wrap it with edebug calls, if the conditions are right.
-  ;; Here we just catch any no-match not caught below and signal an error.
-
-  ;; Run the setup hook.
-  (run-hooks 'edebug-setup-hook)
-  (setq edebug-setup-hook nil)
-
-  (let (result
-	edebug-top-window-data
-	edebug-def-name;; make sure it is locally nil
-	;; I don't like these here!!
-	edebug-&optional
-	edebug-&rest
-	edebug-gate
-	edebug-best-error
-	edebug-error-point
-	no-match
-	;; Do this once here instead of several times.
-	(max-lisp-eval-depth (+ 800 max-lisp-eval-depth))
-	(max-specpdl-size (+ 2000 max-specpdl-size)))
-    (setq no-match
-	  (catch 'no-match
-	    (setq result (edebug-read-and-maybe-wrap-form1))
-	    nil))
-    (if no-match
-	(apply 'edebug-syntax-error no-match))
-    result))
-
-
-(defun edebug-read-and-maybe-wrap-form1 ()
-  (let (spec
-	def-kind
-	defining-form-p
-	def-name
-	;; These offset things don't belong here, but to support recursive
-	;; calls to edebug-read, they need to be here.
-	edebug-offsets
-	edebug-offsets-stack
-	edebug-current-offset ; reset to nil
-	)
-    (save-excursion
-      (if (and (eq 'lparen (edebug-next-token-class))
-	       (eq 'symbol (progn (forward-char 1) (edebug-next-token-class))))
-	  ;; Find out if this is a defining form from first symbol
-	  (setq def-kind (edebug-original-read (current-buffer))
-		spec (and (symbolp def-kind) (get-edebug-spec def-kind))
-		defining-form-p (and (listp spec)
-				     (eq '&define (car spec)))
-		;; This is incorrect in general!! But OK most of the time.
-		def-name (if (and defining-form-p 
-				  (eq 'name (car (cdr spec)))
-				  (eq 'symbol (edebug-next-token-class)))
-			     (edebug-original-read (current-buffer))))))
-;;;(message "all defs: %s   all forms: %s"  edebug-all-defs edebug-all-forms)
-    (cond
-     (defining-form-p
-       (if (or edebug-all-defs edebug-all-forms)
-	   ;; If it is a defining form and we are edebugging defs,
-	   ;; then let edebug-list-form start it.
-	   (let ((cursor (edebug-new-cursor 
-			  (list (edebug-read-storing-offsets (current-buffer)))
-			  (list edebug-offsets))))
-	     (car
-	      (edebug-make-form-wrapper
-	       cursor
-	       (edebug-before-offset cursor) 
-	       (1- (edebug-after-offset cursor))
-	       (list (cons (symbol-name def-kind) (cdr spec))))))
-
-	 ;; Not edebugging this form, so reset the symbol's edebug
-	 ;; property to be just a marker at the definition's source code.
-	 ;; This only works for defs with simple names.
-	 (put def-name 'edebug (point-marker))
-	 ;; Also nil out dependent defs.
-	 '(mapcar (function 
-		   (lambda (def)
-		     (put def-name 'edebug nil)))
-		  (get def-name 'edebug-dependents))
-	 (edebug-read-sexp)))
-
-     ;; If all forms are being edebugged, explicitly wrap it.
-     (edebug-all-forms
-      (let ((cursor (edebug-new-cursor 
-		     (list (edebug-read-storing-offsets (current-buffer)))
-		     (list edebug-offsets))))
-	(edebug-make-form-wrapper 
-	 cursor
-	 (edebug-before-offset cursor) 
-	 (edebug-after-offset cursor) 
-	 nil)))
-
-     ;; Not a defining form, and not edebugging.
-     (t (edebug-read-sexp)))
-    ))
-
-
-(defvar edebug-def-args) ; args of defining form.
-(defvar edebug-def-interactive) ; is it an emacs interactive function?
-(defvar edebug-inside-func)  ;; whether code is inside function context.
-;; Currently def-form sets this to nil; def-body sets it to t.
-
-(defun edebug-interactive-p-name ()
-  ;; Return a unique symbol for the variable used to store the
-  ;; status of interactive-p for this function.
-  (intern (format "edebug-%s-interactive-p" edebug-def-name)))
-
-
-(defun edebug-wrap-def-body (forms)
-  "Wrap the FORMS of a definition body."
-  (if edebug-def-interactive
-      (` (let (((, (edebug-interactive-p-name))
-		(interactive-p)))
-	   (, (edebug-make-enter-wrapper forms))))
-    (edebug-make-enter-wrapper forms)))
-
-
-(defun edebug-make-enter-wrapper (forms)
-  ;; Generate the enter wrapper for some forms of a definition.
-  ;; This is not to be used for the body of other forms, e.g. `while',
-  ;; since it wraps the list of forms with a call to `edebug-enter'.
-  ;; Uses the dynamically bound vars edebug-def-name and edebug-def-args.
-  ;; Do this after parsing since that may find a name.
-  (setq edebug-def-name 
-	(or edebug-def-name edebug-old-def-name (edebug-gensym "edebug-anon")))
-  (` (edebug-enter
-      (quote (, edebug-def-name))
-      (, (if edebug-inside-func  
-	     (` (list (,@ 
-		       ;; Doesn't work with more than one def-body!!
-		       ;; But the list will just be reversed.
-		       (nreverse edebug-def-args))))
-	   'nil))
-      (function (lambda () (,@ forms)))
-      )))
-
-
-(defvar edebug-form-begin-marker) ; the mark for def being instrumented
-  
-(defvar edebug-offset-index) ; the next available offset index.
-(defvar edebug-offset-list) ; the list of offset positions.
-
-(defun edebug-inc-offset (offset)
-  ;; modifies edebug-offset-index and edebug-offset-list
-  ;; accesses edebug-func-marc and buffer point
-  (prog1
-      edebug-offset-index
-    (setq edebug-offset-list (cons (- offset edebug-form-begin-marker)
-				   edebug-offset-list)
-	  edebug-offset-index (1+ edebug-offset-index))))
-
-
-(defun edebug-make-before-and-after-form (before-index form after-index)
-  ;; Return the edebug form for the current function at offset BEFORE-INDEX
-  ;; given FORM.  Looks like: 
-  ;; (edebug-after (edebug-before BEFORE-INDEX) AFTER-INDEX FORM)
-  ;; Also increment the offset index for subsequent use.
-  ;; if (not edebug-stop-before-symbols) and form is a symbol,
-  ;; then don't call edebug-before.
-  (list 'edebug-after 
-	(list 'edebug-before before-index)
-	after-index form))
-
-(defun edebug-make-after-form (form after-index)
-  ;; Like edebug-make-before-and-after-form, but only after.
-  (list 'edebug-after 0 after-index form))
-
-
-(defun edebug-unwrap (sexp)
-  "Return the unwrapped SEXP or return it as is if it is not wrapped.
-The SEXP might be the result of wrapping a body, which is a list of 
-expressions; a `progn' form will be returned enclosing these forms."
-  (if (consp sexp)
-      (cond 
-       ((eq 'edebug-after (car sexp))
-	(nth 3 sexp))
-       ((eq 'edebug-enter (car sexp))
-	(let ((forms (nthcdr 2 (nth 1 (nth 3 sexp)))))
-	  (if (> (length forms) 1)
-	      (cons 'progn forms)  ;; could return (values forms) instead.
-	    (car forms))))
-       (t sexp);; otherwise it is not wrapped, so just return it.
-       )
-    sexp))
-
-(defun edebug-unwrap* (sexp)
-  "Return the sexp recursively unwrapped."
-  (let ((new-sexp (edebug-unwrap sexp)))
-    (while (not (eq sexp new-sexp))
-      (setq sexp new-sexp
-	    new-sexp (edebug-unwrap sexp)))
-    (if (consp new-sexp)
-	(mapcar 'edebug-unwrap* new-sexp)
-      new-sexp)))
-
-
-(defun edebug-defining-form (cursor form-begin form-end speclist)
-  ;; Process the defining form, starting outside the form.
-  ;; The speclist is a generated list spec that looks like:
-  ;;   (("def-symbol" defining-form-spec-sans-&define))
-  ;; Skip the first offset.
-  (edebug-set-cursor cursor (edebug-cursor-expressions cursor)
-		     (cdr (edebug-cursor-offsets cursor)))
-  (edebug-make-form-wrapper 
-   cursor 
-   form-begin (1- form-end)
-   speclist))
-
-(defun edebug-make-form-wrapper (cursor form-begin form-end
-					&optional speclist)
-  ;; Wrap a form, usually a defining form, but any evaluated one.
-  ;; If speclist is non-nil, this is being called by edebug-defining-form.
-  ;; Otherwise it is being called from edebug-read-and-maybe-wrap-form1.
-  ;; This is a hack, but I havent figured out a simpler way yet.
-  (let* ((form-data-entry (edebug-get-form-data-entry form-begin form-end))
-	 ;; Set this marker before parsing.
-	 (edebug-form-begin-marker 	       
-	  (if form-data-entry 
-	      (edebug-form-data-begin form-data-entry)
-	    ;; Buffer must be current-buffer for this to work:
-	    (set-marker (make-marker) form-begin))))
-
-    (let (edebug-offset-list
-	  (edebug-offset-index 0)
-	  result
-	  ;; For definitions.
-	  ;; (edebug-containing-def-name edebug-def-name)
-	  ;; Get name from form-data, if any.
-	  (edebug-old-def-name (edebug-form-data-name form-data-entry))
-	  edebug-def-name
-	  edebug-def-args
-	  edebug-def-interactive
-	  edebug-inside-func;; whether wrapped code executes inside a function.
-	  )
-    
-      (setq result
-	    (if speclist
-		(edebug-match cursor speclist)
-
-	      ;; else wrap as an enter-form.
-	      (edebug-make-enter-wrapper (list (edebug-form cursor)))))
-    
-      ;; Set the name here if it was not set by edebug-make-enter-wrapper.
-      (setq edebug-def-name 
-	    (or edebug-def-name edebug-old-def-name (edebug-gensym "edebug-anon")))
-
-      ;; Add this def as a dependent of containing def.  Buggy.
-      '(if (and edebug-containing-def-name
-		(not (get edebug-containing-def-name 'edebug-dependents)))
-	   (put edebug-containing-def-name 'edebug-dependents
-		(cons edebug-def-name 
-		      (get edebug-containing-def-name 
-			   'edebug-dependents))))
-
-      ;; Create a form-data-entry or modify existing entry's markers.
-      ;; In the latter case, pointers to the entry remain eq.
-      (if (not form-data-entry)
-	  (setq form-data-entry 
-		(edebug-make-form-data-entry
-		 edebug-def-name 
-		 edebug-form-begin-marker
-		 ;; Buffer must be current-buffer.
-		 (set-marker (make-marker) form-end)
-		 ))
-	(edebug-set-form-data-entry 
-	 form-data-entry edebug-def-name ;; in case name is changed
-	 form-begin form-end))
-
-      ;;    (message "defining: %s" edebug-def-name) (sit-for 2)
-      (edebug-make-top-form-data-entry form-data-entry)
-      (message "Edebug: %s" edebug-def-name)
-      ;;(debug edebug-def-name)
-
-      ;; Destructively reverse edebug-offset-list and make vector from it.
-      (setq edebug-offset-list (vconcat (nreverse edebug-offset-list)))
-
-      ;; Side effects on the property list of edebug-def-name.
-      (edebug-clear-frequency-count edebug-def-name)
-      (edebug-clear-coverage edebug-def-name)
-
-      ;; Set up the initial window data.
-      (if (not edebug-top-window-data) ;; if not already set, do it now.
-	  (let ((window ;; Find the best window for this buffer.
-		 (or (get-buffer-window (current-buffer))
-		     (selected-window))))
-	    (setq edebug-top-window-data 
-		  (cons window (window-start window)))))
-
-      ;; Store the edebug data in symbol's property list.
-      (put edebug-def-name 'edebug
-	   ;; A struct or vector would be better here!!
-	   (list edebug-form-begin-marker
-		 nil			; clear breakpoints
-		 edebug-offset-list
-		 edebug-top-window-data
-		 ))
-      result
-      )))
-
-
-(defun edebug-clear-frequency-count (name)
-  ;; Create initial frequency count vector.
-  ;; For each stop point, the counter is incremented each time it is visited.
-  (put name 'edebug-freq-count
-       (make-vector (length edebug-offset-list) 0)))
-
-
-(defun edebug-clear-coverage (name)
-  ;; Create initial coverage vector.  
-  ;; Only need one per expression, but it is simpler to use stop points.
-  (put name 'edebug-coverage 
-       (make-vector (length edebug-offset-list) 'unknown)))
-
-
-(defun edebug-form (cursor)
-  ;; Return the instrumented form for the following form.  
-  ;; Add the point offsets to the edebug-offset-list for the form.
-  (let* ((form (edebug-top-element-required cursor "Expected form"))
-	 (offset (edebug-top-offset cursor)))
-    (prog1
-	(cond
-	 ((consp form)
-	  ;; The first offset for a list form is for the list form itself.
-	  (if (eq 'quote (car form))
-	      form
-	    (let* ((head (car form))
-		   (spec (and (symbolp head) (get-edebug-spec head)))
-		   (new-cursor (edebug-new-cursor form offset)))
-	      ;; Find out if this is a defining form from first symbol.
-	      ;; An indirect spec would not work here, yet.
-	      (if (and (consp spec) (eq '&define (car spec)))
-		  (edebug-defining-form 
-		   new-cursor 
-		   (car offset);; before the form
-		   (edebug-after-offset cursor) 
-		   (cons (symbol-name head) (cdr spec)))
-		;; Wrap a regular form.
-		(edebug-make-before-and-after-form 
-		 (edebug-inc-offset (car offset))
-		 (edebug-list-form new-cursor)
-		 ;; After processing the list form, the new-cursor is left
-		 ;; with the offset after the form.
-		 (edebug-inc-offset (edebug-cursor-offsets new-cursor))))
-	      )))
-
-	 ((symbolp form)
-	  (cond
-	   ;; Check for constant symbols that don't get wrapped.
-	   ((or (memq form '(t nil))
-		(and (fboundp 'edebug-keywordp) (edebug-keywordp form)))
-	    form)
-
-	   ;; This option may go away.
-	   (edebug-stop-before-symbols
-	    (edebug-make-before-and-after-form 
-	     (edebug-inc-offset (car offset))
-	     form
-	     (edebug-inc-offset (cdr offset))
-	     ))
-
-	   (t ;; just a variable
-	    (edebug-make-after-form form (edebug-inc-offset (cdr offset))))))
-
-	 ;; Anything else is self-evaluating.
-	 (t form))
-    (edebug-move-cursor cursor))))
-
-
-(defsubst edebug-forms (cursor)  (edebug-match cursor '(&rest form)))
-(defsubst edebug-sexps (cursor)  (edebug-match cursor '(&rest sexp)))
-
-(defsubst edebug-list-form-args (head cursor)
-  ;; Process the arguments of a list form given that head of form is a symbol.
-  ;; Helper for edebug-list-form
-  (let ((spec (get-edebug-spec head)))
-    (cond
-     (spec
-      (cond
-       ((consp spec)
-	;; It is a speclist.
-	(let (edebug-best-error
-	      edebug-error-point);; This may not be needed.
-	  (edebug-match-sublist cursor spec)))
-       ((eq t spec) (edebug-forms cursor))
-       ((eq 0 spec) (edebug-sexps cursor))
-       ((symbolp spec) (funcall spec cursor));; Not used by edebug,
-					; but leave it in for compatibility.
-       ))
-     ;; No edebug-form-spec provided.
-     ((edebug-macrop head)
-      (if edebug-eval-macro-args
-	  (edebug-forms cursor)
-	(edebug-sexps cursor)))
-     (t ;; Otherwise it is a function call.
-      (edebug-forms cursor)))))
-
-
-(defun edebug-list-form (cursor)
-  ;; Return an instrumented form built from the list form.
-  ;; The after offset will be left in the cursor after processing the form.
-  (let ((head (edebug-top-element-required cursor "Expected elements"))
-	;; Prevent backtracking whenever instrumenting.
-	(edebug-gate t)
-	;; A list form is never optional because it matches anything.
-	(edebug-&optional nil)
-	(edebug-&rest nil))
-    ;; Skip the first offset.
-    (edebug-set-cursor cursor (edebug-cursor-expressions cursor)
-		       (cdr (edebug-cursor-offsets cursor)))
-    (cond
-     ((null head) nil) ; () is legal.
-
-     ((symbolp head)
-      (cond
-       ((null head)
-	(edebug-syntax-error "nil head"))
-       ((eq head 'interactive-p)
-	;; Special case: replace (interactive-p) with variable
-	(setq edebug-def-interactive 'check-it)
-	(edebug-move-cursor cursor)
-	(edebug-interactive-p-name))
-       (t
-	(cons head (edebug-list-form-args 
-		    head (edebug-move-cursor cursor))))))
-
-     ((consp head)
-      (if (and (listp head) (eq (car head) ',))
-	  (edebug-match cursor '(("," def-form) body))
-	;; Process anonymous function and args.
-	;; This assumes no anonymous macros.
-	(edebug-match-specs cursor '(lambda-expr body) 'edebug-match-specs)))
-
-     (t (edebug-syntax-error
-	 "Head of list form must be a symbol or lambda expression.")))
-      ))
-
-;;; Matching of specs.
-
-(defvar edebug-after-dotted-spec nil)
-
-(defvar edebug-matching-depth 0)  ;; initial value
-(defconst edebug-max-depth 150)  ;; maximum number of matching recursions.
-
-
-;;; Failure to match 
-
-;; This throws to no-match, if there are higher alternatives.
-;; Otherwise it signals an error.  The place of the error is found
-;; with the two before- and after-offset functions.
-
-(defun edebug-no-match (cursor &rest edebug-args)
-  ;; Throw a no-match, or signal an error immediately if gate is active.
-  ;; Remember this point in case we need to report this error.
-  (setq edebug-error-point (or edebug-error-point
-			       (edebug-before-offset cursor))
-	edebug-best-error (or edebug-best-error edebug-args))
-  (if (and edebug-gate (not edebug-&optional))
-      (progn
-	(if edebug-error-point
-	    (goto-char edebug-error-point))
-	(apply 'edebug-syntax-error edebug-args))
-    (funcall 'throw 'no-match edebug-args)))
-
-
-(defun edebug-match (cursor specs)
-  ;; Top level spec matching function.
-  ;; Used also at each lower level of specs.
-  (let (edebug-&optional
-	edebug-&rest
-	edebug-best-error
-	edebug-error-point
-	(edebug-gate edebug-gate)  ;; locally bound to limit effect
-	)
-    (edebug-match-specs cursor specs 'edebug-match-specs)))
-
-
-(defun edebug-match-one-spec (cursor spec)
-  ;; Match one spec, which is not a keyword &-spec.
-  (cond
-   ((symbolp spec) (edebug-match-symbol cursor spec))
-   ((vectorp spec) (edebug-match cursor (append spec nil)))
-   ((stringp spec) (edebug-match-string cursor spec))
-   ((listp spec) (edebug-match-list cursor spec))
-   ))
-
-
-(defun edebug-match-specs (cursor specs remainder-handler)
-  ;; Append results of matching the list of specs.
-  ;; The first spec is handled and the remainder-handler handles the rest.
-  (let ((edebug-matching-depth 
-	 (if (> edebug-matching-depth edebug-max-depth)
-	     (error "too deep - perhaps infinite loop in spec?")
-	   (1+ edebug-matching-depth))))
-    (cond
-     ((null specs) nil)
-  
-     ;; Is the spec dotted?
-     ((atom specs)  
-      (let ((edebug-dotted-spec t));; Containing spec list was dotted.
-	(edebug-match-specs cursor (list specs) remainder-handler)))
-
-     ;; Is the form dotted?
-     ((not (listp (edebug-cursor-expressions cursor)));; allow nil
-      (if (not edebug-dotted-spec)
-	  (edebug-no-match cursor "Dotted spec required."))
-      ;; Cancel dotted spec and dotted form.
-      (let ((edebug-dotted-spec)
-	    (this-form (edebug-cursor-expressions cursor))
-	    (this-offset (edebug-cursor-offsets cursor)))
-	;; Wrap the form in a list, (by changing the cursor??)...
-	(edebug-set-cursor cursor (list this-form) this-offset)
-	;; and process normally, then unwrap the result.
-	(car (edebug-match-specs cursor specs remainder-handler))))
-
-     (t;; Process normally.
-      (let* ((spec (car specs))
-	     (rest)	  
-	     (first-char (and (symbolp spec) (aref (symbol-name spec) 0))))
-	;;(message "spec = %s  first char = %s" spec first-char) (sit-for 1)
-	(nconc
-	 (cond
-	  ((eq ?& first-char);; "&" symbols take all following specs.
-	   (funcall (get-edebug-spec spec) cursor (cdr specs)))
-	  ((eq ?: first-char);; ":" symbols take one following spec.
-	   (setq rest (cdr (cdr specs)))
-	   (funcall (get-edebug-spec spec) cursor (car (cdr specs))))
-	  (t;; Any other normal spec.
-	   (setq rest (cdr specs))
-	   (edebug-match-one-spec cursor spec)))
-	 (funcall remainder-handler cursor rest remainder-handler)))))))
-
-
-;; Define specs for all the symbol specs with functions used to process them.
-;; Perhaps we shouldn't be doing this with edebug-form-specs since the
-;; user may want to define macros or functions with the same names.
-;; We could use an internal obarray for these primitive specs.
-
-(mapcar 
- (function (lambda (pair)
-	     (put (car pair) 'edebug-form-spec (cdr pair))))
- '((&optional . edebug-match-&optional)
-   (&rest . edebug-match-&rest)
-   (&or . edebug-match-&or)
-   (form . edebug-match-form)
-   (sexp . edebug-match-sexp)
-   (body . edebug-match-body)
-   (&define . edebug-match-&define)
-   (name . edebug-match-name)
-   (:name . edebug-match-colon-name)
-   (arg . edebug-match-arg)
-   (def-body . edebug-match-def-body)
-   (def-form . edebug-match-def-form)
-   ;; Less frequently used:
-   ;; (function . edebug-match-function)
-   (lambda-expr . edebug-match-lambda-expr)
-   (&not . edebug-match-&not)
-   (&key . edebug-match-&key)
-   (place . edebug-match-place)
-   (gate . edebug-match-gate)
-   ;;   (nil . edebug-match-nil)  not this one - special case it.
-   ))
-
-(defun edebug-match-symbol (cursor symbol)
-  ;; Match a symbol spec.
-  (let* ((spec (get-edebug-spec symbol)))
-    (cond
-     (spec 
-      (if (consp spec)
-	  ;; It is an indirect spec.
-	  (edebug-match cursor spec)
-	;; Otherwise it should be the symbol name of a function.
-	;; There could be a bug here - maybe need to do edebug-match bindings.
-	(funcall spec cursor)))
-	   
-     ((null symbol)  ;; special case this.
-      (edebug-match-nil cursor))
-
-     ((fboundp symbol)			; is it a predicate? 
-      (let ((sexp (edebug-top-element-required cursor "Expected" symbol)))
-	;; Special case for edebug-`.
-	(if (and (listp sexp) (eq (car sexp) ',))
-	    (edebug-match cursor '(("," def-form)))
-	  (if (not (funcall symbol sexp))
-	      (edebug-no-match cursor symbol "failed"))
-	  (edebug-move-cursor cursor)
-	  (list sexp))))
-     (t (error "%s is not a form-spec or function" symbol))
-     )))
-
-
-(defun edebug-match-sexp (cursor)
-  (list (prog1 (edebug-top-element-required cursor "Expected sexp")
-	  (edebug-move-cursor cursor))))
-
-(defun edebug-match-form (cursor)
-  (list (edebug-form cursor)))
-
-(defalias 'edebug-match-place 'edebug-match-form)
-  ;; Currently identical to edebug-match-form.
-  ;; This is for common lisp setf-style place arguments.
-
-(defsubst edebug-match-body (cursor) (edebug-forms cursor))
-
-(defun edebug-match-&optional (cursor specs)
-  ;; Keep matching until one spec fails.
-  (edebug-&optional-wrapper cursor specs 'edebug-&optional-wrapper))
-
-(defun edebug-&optional-wrapper (cursor specs remainder-handler)
-  (let (result
-	(edebug-&optional specs)
-	(edebug-gate nil)
-	(this-form (edebug-cursor-expressions cursor))
-	(this-offset (edebug-cursor-offsets cursor)))
-    (if (null (catch 'no-match
-		(setq result
-		      (edebug-match-specs cursor specs remainder-handler))
-		;; Returning nil means no no-match was thrown.
-		nil))
-	result
-      ;; no-match, but don't fail; just reset cursor and return nil.
-      (edebug-set-cursor cursor this-form this-offset)
-      nil)))
-
-
-(defun edebug-&rest-wrapper (cursor specs remainder-handler)
-  (if (null specs) (setq specs edebug-&rest))
-  ;; Reuse the &optional handler with this as the remainder handler.
-  (edebug-&optional-wrapper cursor specs remainder-handler))
-  
-(defun edebug-match-&rest (cursor specs)
-  ;; Repeatedly use specs until failure.
-  (let ((edebug-&rest specs) ;; remember these
-	edebug-best-error
-	edebug-error-point)
-    (edebug-&rest-wrapper cursor specs 'edebug-&rest-wrapper)))
-
-
-(defun edebug-match-&or (cursor specs)
-  ;; Keep matching until one spec succeeds, and return its results.
-  ;; If none match, fail.
-  ;; This needs to be optimized since most specs spend time here.
-  (let ((original-specs specs)
-	(this-form (edebug-cursor-expressions cursor))
-	(this-offset (edebug-cursor-offsets cursor)))
-    (catch 'matched
-      (while specs
-	(catch 'no-match
-	  (throw 'matched
-		 (let (edebug-gate ;; only while matching each spec
-		       edebug-best-error
-		       edebug-error-point)
-		   ;; Doesn't support e.g. &or symbolp &rest form
-		   (edebug-match-one-spec cursor (car specs)))))
-	;; Match failed, so reset and try again.
-	(setq specs (cdr specs))
-	;; Reset the cursor for the next match.
-	(edebug-set-cursor cursor this-form this-offset))
-      ;; All failed.
-      (apply 'edebug-no-match cursor "Expected one of" original-specs))
-    ))
-
-
-(defun edebug-match-&not (cursor specs)
-  ;; If any specs match, then fail
-  (if (null (catch 'no-match
-	      (let ((edebug-gate nil))
-		(save-excursion
-		  (edebug-match-&or cursor specs)))
-	      nil))
-      ;; This means something matched, so it is a no match.
-      (edebug-no-match cursor "Unexpected"))
-  ;; This means nothing matched, so it is OK.
-  nil) ;; So, return nothing
-  
-
-(def-edebug-spec &key edebug-match-&key)
-
-(defun edebug-match-&key (cursor specs)
-  ;; Following specs must look like (<name> <spec>) ...
-  ;; where <name> is the name of a keyword, and spec is its spec.
-  ;; This really doesn't save much over the expanded form and takes time.
-  (edebug-match-&rest 
-   cursor
-   (cons '&or 
-	 (mapcar (function (lambda (pair)
-			     (vector (format ":%s" (car pair)) 
-				     (car (cdr pair)))))
-		 specs))))
-
-
-(defun edebug-match-gate (cursor)
-  ;; Simply set the gate to prevent backtracking at this level.
-  (setq edebug-gate t)
-  nil)
-
-
-(defun edebug-match-list (cursor specs)
-  ;; The spec is a list, but what kind of list, and what context?
-  (if edebug-dotted-spec
-      ;; After dotted spec but form did not contain dot, 
-      ;; so match list spec elements as if spliced in.
-      (prog1
-	  (let ((edebug-dotted-spec))
-	    (edebug-match-specs cursor specs 'edebug-match-specs))
-	;; If it matched, really clear the dotted-spec flag.
-	(setq edebug-dotted-spec nil))
-    (let ((spec (car specs))
-	  (form (edebug-top-element-required cursor "Expected" specs)))
-      (cond
-       ((eq 'quote spec)
-	(let ((spec (car (cdr specs))))
-	  (cond
-	   ((symbolp spec)
-	    ;; Special case: spec quotes a symbol to match.
-	    ;; Change in future.  Use "..." instead.
-	    (if (not (eq spec form))
-		(edebug-no-match cursor "Expected" spec))
-	    (edebug-move-cursor cursor)
-	    (setq edebug-gate t)
-	    form)
-	   (t 
-	    (error "Bad spec: %s" specs)))))
-
-       ((listp form)
-	(prog1
-	    (list (edebug-match-sublist 
-		   ;; First offset is for the list form itself.
-		   ;; Treat nil as empty list.
-		   (edebug-new-cursor form (cdr (edebug-top-offset cursor))) 
-		   specs))
-	  (edebug-move-cursor cursor)))
-
-       ((and (eq 'vector spec) (vectorp form))
-	;; Special case: match a vector with the specs.
-	(let ((result (edebug-match-sublist
-		       (edebug-new-cursor 
-			form (cdr (edebug-top-offset cursor)))
-		       (cdr specs))))
-	  (edebug-move-cursor cursor)
-	  (list (apply 'vector result))))
-     
-       (t (edebug-no-match cursor "Expected" specs)))
-      )))
-
-
-(defun edebug-match-sublist (cursor specs)
-  ;; Match a sublist of specs.
-  (let (edebug-&optional
-	;;edebug-best-error
-	;;edebug-error-point
-	)
-    (prog1 
-	;; match with edebug-match-specs so edebug-best-error is not bound.
-	(edebug-match-specs cursor specs 'edebug-match-specs)
-      (if (not (edebug-empty-cursor cursor))
-	  (if edebug-best-error 
-	      (apply 'edebug-no-match cursor edebug-best-error)
-	    ;; A failed &rest or &optional spec may leave some args.
-	    (edebug-no-match cursor "Failed matching" specs)
-	    )))))
-
-
-(defun edebug-match-string (cursor spec)
-  (let ((sexp (edebug-top-element-required cursor "Expected" spec)))
-    (if (not (eq (intern spec) sexp))
-	(edebug-no-match cursor "Expected" spec)
-      ;; Since it matched, failure means immediate error, unless &optional.
-      (setq edebug-gate t)
-      (edebug-move-cursor cursor)
-      (list sexp)
-      )))
-
-(defun edebug-match-nil (cursor)
-  ;; There must be nothing left to match a nil.
-  (if (not (edebug-empty-cursor cursor))
-      (edebug-no-match cursor "Unmatched argument(s)")
-    nil))
-
-
-(defun edebug-match-function (cursor)
-  (error "Use function-form instead of function in edebug spec"))
-
-(defun edebug-match-&define (cursor specs)
-  ;; Match a defining form.
-  ;; Normally, &define is interpreted specially other places.
-  ;; This should only be called inside of a spec list to match the remainder
-  ;; of the current list.  e.g. ("lambda" &define args def-body)
-   (edebug-make-form-wrapper
-    cursor 
-    (edebug-before-offset cursor)
-    ;; Find the last offset in the list.
-    (let ((offsets (edebug-cursor-offsets cursor)))
-      (while (consp offsets) (setq offsets (cdr offsets)))
-      offsets)
-    specs))
-
-(defun edebug-match-lambda-expr (cursor)
-  ;; The expression must be a function.
-  ;; This will match any list form that begins with a symbol
-  ;; that has an edebug-form-spec beginning with &define.  In
-  ;; practice, only lambda expressions should be used.  
-  ;; I could add a &lambda specification to avoid confusion.
-  (let* ((sexp (edebug-top-element-required 
-		cursor "Expected lambda expression"))
-	 (offset (edebug-top-offset cursor))
-	 (head (and (consp sexp) (car sexp)))
-	 (spec (and (symbolp head) (get-edebug-spec head)))
-	 (edebug-inside-func nil))
-    ;; Find out if this is a defining form from first symbol.
-    (if (and (consp spec) (eq '&define (car spec)))
-	(prog1
-	    (list
-	     (edebug-defining-form 
-	      (edebug-new-cursor sexp offset)
-	      (car offset);; before the sexp
-	      (edebug-after-offset cursor) 
-	      (cons (symbol-name head) (cdr spec))))
-	  (edebug-move-cursor cursor))
-      (edebug-no-match cursor "Expected lambda expression")
-      )))
-
-
-(defun edebug-match-name (cursor)
-  ;; Set the edebug-def-name bound in edebug-defining-form.
-  (let ((name (edebug-top-element-required cursor "Expected name")))
-    ;; Maybe strings and numbers could be used.
-    (if (not (symbolp name))
-	(edebug-no-match cursor "Symbol expected for name of definition"))
-    (setq edebug-def-name
-	  (if edebug-def-name
-	      ;; Construct a new name by appending to previous name.
-	      (intern (format "%s@%s" edebug-def-name name))
-	    name))
-    (edebug-move-cursor cursor)
-    (list name)))
-
-(defun edebug-match-colon-name (cursor spec)
-  ;; Set the edebug-def-name to the spec.
-  (setq edebug-def-name
-	(if edebug-def-name
-	    ;; Construct a new name by appending to previous name.
-	    (intern (format "%s@%s" edebug-def-name spec))
-	  spec))
-  nil)
-
-(defun edebug-match-arg (cursor)
-  ;; set the def-args bound in edebug-defining-form
-  (let ((edebug-arg (edebug-top-element-required cursor "Expected arg")))
-    (if (or (not (symbolp edebug-arg))
-	    (edebug-lambda-list-keywordp edebug-arg))
-      (edebug-no-match cursor "Bad argument:" edebug-arg))
-    (edebug-move-cursor cursor)
-    (setq edebug-def-args (cons edebug-arg edebug-def-args))
-    (list edebug-arg)))
-
-(defun edebug-match-def-form (cursor)
-  ;; Like form but the form is wrapped in edebug-enter form.
-  ;; The form is assumed to be executing outside of the function context.
-  ;; This is a hack for now, since a def-form might execute inside as well.
-  ;; Not to be used otherwise.
-  (let ((edebug-inside-func nil))
-    (list (edebug-make-enter-wrapper (list (edebug-form cursor))))))
-
-(defun edebug-match-def-body (cursor)
-  ;; Like body but body is wrapped in edebug-enter form.
-  ;; The body is assumed to be executing inside of the function context.
-  ;; Not to be used otherwise.
-  (let ((edebug-inside-func t))
-    (list (edebug-wrap-def-body (edebug-forms cursor)))))
-
-
-;;;; Edebug Form Specs
-;;; ==========================================================
-;;; See cl-specs.el for common lisp specs.
-
-;;;;* Spec for def-edebug-spec
-;;; Out of date.
-
-(defun edebug-spec-p (object)
-  "Return non-nil if OBJECT is a symbol with an edebug-form-spec property."
-  (and (symbolp object)
-       (get object 'edebug-form-spec)))
-
-(def-edebug-spec def-edebug-spec
-  ;; Top level is different from lower levels.
-  (&define :name edebug-spec name 
-	   &or "nil" edebug-spec-p "t" "0" (&rest edebug-spec)))
-
-(def-edebug-spec edebug-spec-list
-  ;; A list must have something in it, or it is nil, a symbolp
-  ((edebug-spec . [&or nil edebug-spec])))
-
-(def-edebug-spec edebug-spec
-  (&or
-   (vector &rest edebug-spec)		; matches a vector
-   ("vector" &rest edebug-spec)		; matches a vector spec
-   ("quote" symbolp)
-   edebug-spec-list
-   stringp
-   [edebug-lambda-list-keywordp &rest edebug-spec]
-   ;; [edebug-keywordp gate edebug-spec] ;; need edebug-keywordp for this.
-   edebug-spec-p  ;; Including all the special ones e.g. form.
-   symbolp;; a predicate
-   ))
-
-
-;;;* Emacs special forms and some functions.
-
-;; quote expects only one argument, although it allows any number.
-(def-edebug-spec quote sexp)
-
-;; The standard defining forms.
-(def-edebug-spec defconst defvar)
-(def-edebug-spec defvar (symbolp &optional form stringp))
-
-(def-edebug-spec defun
-  (&define name lambda-list
-	   [&optional stringp]
-	   [&optional ("interactive" interactive)]
-	   def-body))
-(def-edebug-spec defmacro
-  (&define name lambda-list def-body))
-
-(def-edebug-spec arglist lambda-list)  ;; deprecated - use lambda-list.
-
-(def-edebug-spec lambda-list
-  (([&rest arg]
-    [&optional ["&optional" arg &rest arg]]
-    &optional ["&rest" arg]
-    )))
-
-(def-edebug-spec interactive
-  (&optional &or stringp def-form))
-
-;; A function-form is for an argument that may be a function or a form.
-;; This specially recognizes anonymous functions quoted with quote.
-(def-edebug-spec function-form
-  ;; form at the end could also handle "function",
-  ;; but recognize it specially to avoid wrapping function forms.
-  (&or ([&or "quote" "function"] &or symbolp lambda-expr) form))
-
-;; function expects a symbol or a lambda or macro expression
-;; A macro is allowed by Emacs.
-(def-edebug-spec function (&or symbolp lambda-expr))
-
-;; lambda is a macro in emacs 19.
-(def-edebug-spec lambda (&define lambda-list
-				 [&optional stringp]
-				 [&optional ("interactive" interactive)]
-				 def-body))
-
-;; A macro expression is a lambda expression with "macro" prepended.
-(def-edebug-spec macro (&define "lambda" lambda-list def-body))
-
-;; (def-edebug-spec anonymous-form ((&or ["lambda" lambda] ["macro" macro])))
-
-;; Standard functions that take function-forms arguments.
-(def-edebug-spec mapcar (function-form form))
-(def-edebug-spec mapconcat (function-form form form))
-(def-edebug-spec mapatoms (function-form &optional form))
-(def-edebug-spec apply (function-form &rest form))
-(def-edebug-spec funcall (function-form &rest form))
-
-(def-edebug-spec let
-  ((&rest &or (symbolp &optional form) symbolp)
-   body))
-
-(def-edebug-spec let* let)
-
-(def-edebug-spec setq (&rest symbolp form))
-(def-edebug-spec setq-default setq)
-
-(def-edebug-spec cond (&rest (&rest form)))
-
-(def-edebug-spec condition-case
-  (symbolp
-   form
-   &rest (symbolp body)))
-
-
-(def-edebug-spec \` (backquote-form))
-
-;; Supports quotes inside backquotes, 
-;; but only at the top level inside unquotes.
-(def-edebug-spec backquote-form
-  (&or
-   ([&or "," ",@"] &or ("quote" backquote-form) form)
-   (backquote-form &rest backquote-form)
-   ;; If you use dotted forms in backquotes, replace the previous line
-   ;; with the following.  This takes quite a bit more stack space, however.
-   ;; (backquote-form . [&or nil backquote-form])
-   (vector &rest backquote-form)
-   sexp))
-
-;; Special version of backquote that instruments backquoted forms
-;; destined to be evaluated, usually as the result of a
-;; macroexpansion.  Backquoted code can only have unquotes (, and ,@)
-;; in places where list forms are allowed, and predicates. If the
-;; backquote is used in a macro, unquoted code that come from
-;; arguments must be instrumented, if at all, with def-form not def-body.
-
-;; We could assume that all forms (not nested in other forms)
-;; in arguments of macros should be def-forms, whether or not the macros
-;; are defined with edebug-` but this would be expensive.
-
-;; ,@ might have some problems.
-
-(defalias 'edebug-\` '\`)  ;; same macro as regular backquote.
-(def-edebug-spec edebug-\` (def-form))
-
-;; Assume immediate quote in unquotes mean backquote at next higher level.
-(def-edebug-spec , (&or ("quote" edebug-`) def-form))
-(def-edebug-spec ,@ (&define  ;; so (,@ form) is never wrapped.
-		     &or ("quote" edebug-`) def-form))
-
-;; New byte compiler.
-(def-edebug-spec defsubst defun)
-(def-edebug-spec dont-compile t)
-(def-edebug-spec eval-when-compile t)
-(def-edebug-spec eval-and-compile t)
-
-(def-edebug-spec save-selected-window t)
-(def-edebug-spec save-current-buffer t)
-(def-edebug-spec save-match-data t)
-(def-edebug-spec with-output-to-string t)
-(def-edebug-spec with-current-buffer t)
-(def-edebug-spec combine-after-change-calls t)
-(def-edebug-spec with-temp-file t)
-(def-edebug-spec with-temp-buffer t)
-
-;; Anything else?
-
-
-;; Some miscellaneous specs for macros in public packages.
-;; Send me yours.
-
-;; advice.el by Hans Chalupsky (hans@cs.buffalo.edu)
-
-(def-edebug-spec ad-dolist ((symbolp form &optional form) body))
-(def-edebug-spec defadvice 
-  (&define name   ;; thing being advised.
-	   (name  ;; class is [&or "before" "around" "after" 
-	          ;;               "activation" "deactivation"] 
-	    name  ;; name of advice
-	    &rest sexp  ;; optional position and flags
-	    )
-	   [&optional stringp]
-	   [&optional ("interactive" interactive)]
-	   def-body))
-
-;;; The debugger itself
-
-(defvar edebug-active nil)  ;; Non-nil when edebug is active
-
-;;; add minor-mode-alist entry
-(or (assq 'edebug-active minor-mode-alist)
-    (setq minor-mode-alist (cons (list 'edebug-active " *Debugging*")
-				 minor-mode-alist)))
-
-(defvar edebug-stack nil)
-;; Stack of active functions evaluated via edebug.
-;; Should be nil at the top level.
-
-(defvar edebug-stack-depth -1)
-;; Index of last edebug-stack item.
-
-(defvar edebug-offset-indices nil)
-;; Stack of offset indices of visited edebug sexps.
-;; Should be nil at the top level.
-;; Each function adds one cons.  Top is modified with setcar.
-
-
-(defvar edebug-entered nil
-  ;; Non-nil if edebug has already been entered at this recursive edit level.
-  ;; This should stay nil at the top level.
-  )
-
-;; Should these be options?
-(defconst edebug-debugger 'edebug
-  ;; Name of function to use for debugging when error or quit occurs.
-  ;; Set this to 'debug if you want to debug edebug.
-  )
-
-
-;; Dynamically bound variables, declared globally but left unbound.
-(defvar edebug-function) ; the function being executed. change name!!
-(defvar edebug-args) ; the arguments of the function
-(defvar edebug-data) ; the edebug data for the function
-(defvar edebug-value) ; the result of the expression
-(defvar edebug-after-index)
-(defvar edebug-def-mark) ; the mark for the definition
-(defvar edebug-freq-count) ; the count of expression visits.
-(defvar edebug-coverage) ; the coverage results of each expression of function.
-
-(defvar edebug-buffer) ; which buffer the function is in.
-(defvar edebug-result) ; the result of the function call returned by body
-(defvar edebug-outside-executing-macro)
-(defvar edebug-outside-defining-kbd-macro)
-
-(defvar edebug-execution-mode 'step) ; Current edebug mode set by user.
-(defvar edebug-next-execution-mode nil) ; Use once instead of initial mode.
-
-(defvar edebug-outside-debug-on-error) ; the value of debug-on-error outside
-(defvar edebug-outside-debug-on-quit) ; the value of debug-on-quit outside
-
-(defvar edebug-outside-pre-command-hook)
-(defvar edebug-outside-post-command-hook)
-
-(defvar cl-lexical-debug)  ;; Defined in cl.el
-
-;;; Handling signals
-
-(defun edebug-signal (edebug-signal-name edebug-signal-data)
-  "Signal an error.  Args are SIGNAL-NAME, and associated DATA.
-A signal name is a symbol with an `error-conditions' property
-that is a list of condition names.
-A handler for any of those names will get to handle this signal.
-The symbol `error' should always be one of them.
-
-DATA should be a list.  Its elements are printed as part of the error message.
-If the signal is handled, DATA is made available to the handler.
-See `condition-case'.
-
-This is the Edebug replacement for the standard `signal'.  It should
-only be active while Edebug is.  It checks `debug-on-error' to see
-whether it should call the debugger.  When execution is resumed, the
-error is signaled again."
-  (if (and (listp debug-on-error) (memq edebug-signal-name debug-on-error))
-      (edebug 'error (cons edebug-signal-name edebug-signal-data)))
-  ;; If we reach here without another non-local exit, then send signal again.
-  ;; i.e. the signal is not continuable, yet.
-  (signal edebug-signal-name edebug-signal-data))
-
-;;; Entering Edebug
-
-(defun edebug-enter (edebug-function edebug-args edebug-body)
-  ;; Entering FUNC.  The arguments are ARGS, and the body is BODY.
-  ;; Setup edebug variables and evaluate BODY.  This function is called
-  ;; when a function evaluated with edebug-eval-top-level-form is entered.  
-  ;; Return the result of BODY.
-
-  ;; Is this the first time we are entering edebug since
-  ;; lower-level recursive-edit command?
-  ;; More precisely, this tests whether Edebug is currently active.
-  (if (not edebug-entered)
-      (let ((edebug-entered t)
-	    ;; Binding max-lisp-eval-depth here is OK, 
-	    ;; but not inside an unwind-protect.
-	    ;; Doing it here also keeps it from growing too large.
-	    (max-lisp-eval-depth (+ 100 max-lisp-eval-depth)) ; too much??
-	    (max-specpdl-size (+ 200 max-specpdl-size))
-
-	    (debugger edebug-debugger)  ; only while edebug is active.
-	    (edebug-outside-debug-on-error debug-on-error)
-	    (edebug-outside-debug-on-quit debug-on-quit)
-	    ;; Binding these may not be the right thing to do.
-	    ;; We want to allow the global values to be changed.
-	    (debug-on-error (or debug-on-error edebug-on-error))
-	    (debug-on-quit edebug-on-quit)
-
-	    ;; Lexical bindings must be uncompiled for this to work.
-	    (cl-lexical-debug t)
-
-	    ;; Save the outside value of executing macro.  (here??)
-	    (edebug-outside-executing-macro executing-kbd-macro)
-	    (edebug-outside-pre-command-hook pre-command-hook)
-	    (edebug-outside-post-command-hook post-command-hook))
-	(unwind-protect
-	    (let (;; Don't keep reading from an executing kbd macro
-		  ;; within edebug unless edebug-continue-kbd-macro is
-		  ;; non-nil.  Again, local binding may not be best.
-		  (executing-kbd-macro 
-		   (if edebug-continue-kbd-macro executing-kbd-macro))
-
-		  (signal-hook-function 'edebug-signal)
-
-		  ;; Disable command hooks.  This is essential when
-		  ;; a hook function is instrumented - to avoid infinite loop.
-		  ;; This may be more than we need, however.
-		  (pre-command-hook nil)
-		  (post-command-hook nil))
-	      (setq edebug-execution-mode (or edebug-next-execution-mode 
-					      edebug-initial-mode 
-					      edebug-execution-mode)
-		    edebug-next-execution-mode nil)
-	      (edebug-enter edebug-function edebug-args edebug-body))
-	  ;; Reset global variables in case outside value was changed.
-	  (setq executing-kbd-macro edebug-outside-executing-macro
-		pre-command-hook edebug-outside-pre-command-hook
-		post-command-hook edebug-outside-post-command-hook
-		)))
-    
-    (let* ((edebug-data (get edebug-function 'edebug))
-	   (edebug-def-mark (car edebug-data)) ; mark at def start
-	   (edebug-freq-count (get edebug-function 'edebug-freq-count))
-	   (edebug-coverage (get edebug-function 'edebug-coverage))
-	   (edebug-buffer (marker-buffer edebug-def-mark))
-
-	   (edebug-stack (cons edebug-function edebug-stack))
-	   (edebug-offset-indices (cons 0 edebug-offset-indices))
-	   )
-      (if (get edebug-function 'edebug-on-entry)
-	  (progn
-	    (setq edebug-execution-mode 'step)
-	    (if (eq (get edebug-function 'edebug-on-entry) 'temp)
-		(put edebug-function 'edebug-on-entry nil))))
-      (if edebug-trace
-	  (edebug-enter-trace edebug-body)
-	(funcall edebug-body))
-      )))
-
-
-(defun edebug-enter-trace (edebug-body)
-  (let ((edebug-stack-depth (1+ edebug-stack-depth))
-	edebug-result)
-    (edebug-print-trace-before 
-     (format "%s args: %s" edebug-function edebug-args))
-    (prog1 (setq edebug-result (funcall edebug-body))
-      (edebug-print-trace-after
-       (format "%s result: %s" edebug-function edebug-result)))))
-
-(def-edebug-spec edebug-tracing (form body))
-
-(defmacro edebug-tracing (msg &rest body)
-  "Print MSG in *edebug-trace* before and after evaluating BODY.
-The result of BODY is also printed."
-  (` (let ((edebug-stack-depth (1+ edebug-stack-depth))
-	   edebug-result)
-       (edebug-print-trace-before (, msg))
-       (prog1 (setq edebug-result (progn (,@ body)))
-	 (edebug-print-trace-after 
-	  (format "%s result: %s" (, msg) edebug-result))))))
-
-(defun edebug-print-trace-before (msg)
-  "Function called to print trace info before expression evaluation.
-MSG is printed after `::::{ '."
-  (edebug-trace-display
-   edebug-trace-buffer "%s{ %s" (make-string edebug-stack-depth ?\:) msg))
-
-(defun edebug-print-trace-after (msg)
-  "Function called to print trace info after expression evaluation.
-MSG is printed after `::::} '."
-  (edebug-trace-display
-   edebug-trace-buffer "%s} %s" (make-string edebug-stack-depth ?\:) msg))
-
-
-
-(defun edebug-slow-before (edebug-before-index)
-  ;; Debug current function given BEFORE position.
-  ;; Called from functions compiled with edebug-eval-top-level-form.  
-  ;; Return the before index.
-  (setcar edebug-offset-indices edebug-before-index)
-
-  ;; Increment frequency count 
-  (aset edebug-freq-count edebug-before-index
-	(1+ (aref edebug-freq-count edebug-before-index)))
-
-  (if (or (not (memq edebug-execution-mode '(Go-nonstop next)))
-	  (edebug-input-pending-p))
-      (edebug-debugger edebug-before-index 'before nil))
-  edebug-before-index)
-
-(defun edebug-fast-before (edebug-before-index)
-  ;; Do nothing.
-  )
-
-(defun edebug-slow-after (edebug-before-index edebug-after-index edebug-value)
-  ;; Debug current function given AFTER position and VALUE.
-  ;; Called from functions compiled with edebug-eval-top-level-form.
-  ;; Return VALUE.
-  (setcar edebug-offset-indices edebug-after-index)
-
-  ;; Increment frequency count 
-  (aset edebug-freq-count edebug-after-index
-	(1+ (aref edebug-freq-count edebug-after-index)))
-  (if edebug-test-coverage (edebug-update-coverage))
-
-  (if (and (eq edebug-execution-mode 'Go-nonstop)
-	   (not (edebug-input-pending-p)))
-      ;; Just return result.
-      edebug-value
-    (edebug-debugger edebug-after-index 'after edebug-value)
-    ))
-
-(defun edebug-fast-after (edebug-before-index edebug-after-index edebug-value)
-  ;; Do nothing but return the value.
-  edebug-value)
-
-(defun edebug-run-slow ()
-  (defalias 'edebug-before 'edebug-slow-before)
-  (defalias 'edebug-after 'edebug-slow-after))
-
-;; This is not used, yet.
-(defun edebug-run-fast ()
-  (defalias 'edebug-before 'edebug-fast-before)
-  (defalias 'edebug-after 'edebug-fast-after))
-
-(edebug-run-slow)
-
-
-(defun edebug-update-coverage ()
-  (let ((old-result (aref edebug-coverage edebug-after-index)))
-    (cond
-     ((eq 'ok-coverage old-result))
-     ((eq 'unknown old-result)
-      (aset edebug-coverage edebug-after-index edebug-value))
-     ;; Test if a different result.
-     ((not (eq edebug-value old-result))
-      (aset edebug-coverage edebug-after-index 'ok-coverage)))))
-
-
-;; Dynamically declared unbound variables.
-(defvar edebug-arg-mode)  ; the mode, either before, after, or error
-(defvar edebug-breakpoints)
-(defvar edebug-break-data) ; break data for current function.
-(defvar edebug-break) ; whether a break occurred.
-(defvar edebug-global-break) ; whether a global break occurred.
-(defvar edebug-break-condition) ; whether the breakpoint is conditional.
-
-(defvar edebug-break-result nil)
-(defvar edebug-global-break-result nil)
-
-
-(defun edebug-debugger (edebug-offset-index edebug-arg-mode edebug-value)
-  ;; Check breakpoints and pending input.
-  ;; If edebug display should be updated, call edebug-display.
-  ;; Return edebug-value.
-  (let* (;; This needs to be here since breakpoints may be changed.
-	 (edebug-breakpoints (car (cdr edebug-data))) ; list of breakpoints
-	 (edebug-break-data (assq edebug-offset-index edebug-breakpoints))
-	 (edebug-break-condition (car (cdr edebug-break-data)))
-	 (edebug-global-break
-	  (if edebug-global-break-condition
-	      (condition-case nil
-		  (setq edebug-global-break-result
-			(eval edebug-global-break-condition))
-		(error nil))))
-	 (edebug-break))
-
-;;;    (edebug-trace "exp: %s" edebug-value)
-    ;; Test whether we should break.
-    (setq edebug-break 
-	  (or edebug-global-break
-	      (and edebug-break-data
-		   (or (not edebug-break-condition)
-		       (setq edebug-break-result
-			     (eval edebug-break-condition))))))
-    (if (and edebug-break
-	     (nth 2 edebug-break-data)) ; is it temporary?
-	;; Delete the breakpoint.
-	(setcdr edebug-data
-		(cons (delq edebug-break-data edebug-breakpoints)
-		      (cdr (cdr edebug-data)))))
-
-    ;; Display if mode is not go, continue, or Continue-fast
-    ;; or break, or input is pending, 
-    (if (or (not (memq edebug-execution-mode '(go continue Continue-fast)))
-	    edebug-break
-	    (edebug-input-pending-p))
-	(edebug-display))   ; <--------------- display
-    
-    edebug-value
-    ))
-
-
-;; window-start now stored with each function.
-;;(defvar edebug-window-start nil)
-;; Remember where each buffers' window starts between edebug calls.
-;; This is to avoid spurious recentering.
-;; Does this still need to be buffer-local??
-;;(setq-default edebug-window-start nil)
-;;(make-variable-buffer-local 'edebug-window-start)
-
-
-;; Dynamically declared unbound vars
-(defvar edebug-point) ; the point in edebug buffer
-(defvar edebug-outside-buffer) ; the current-buffer outside of edebug
-(defvar edebug-outside-point) ; the point outside of edebug
-(defvar edebug-outside-mark) ; the mark outside of edebug
-(defvar edebug-window-data)  ; window and window-start for current function
-(defvar edebug-outside-windows) ; outside window configuration
-(defvar edebug-eval-buffer) ; for the evaluation list.
-(defvar edebug-outside-o-a-p) ; outside overlay-arrow-position
-(defvar edebug-outside-o-a-s) ; outside overlay-arrow-string
-(defvar edebug-outside-c-i-e-a) ; outside cursor-in-echo-area
-
-(defvar edebug-eval-list nil) ;; List of expressions to evaluate.
-
-(defvar edebug-previous-result nil) ;; Last result returned.
-
-;; Emacs 19 adds an arg to mark and mark-marker.
-(defalias 'edebug-mark 'mark)
-(defalias 'edebug-mark-marker 'mark-marker)
-
-
-(defun edebug-display ()
-  ;; Setup windows for edebug, determine mode, maybe enter recursive-edit.
-  ;; Uses local variables of edebug-enter, edebug-before, edebug-after
-  ;; and edebug-debugger.
-  (let ((edebug-active t)		; for minor mode alist
-	edebug-stop			; should we enter recursive-edit
-	(edebug-point (+ edebug-def-mark
-			 (aref (nth 2 edebug-data) edebug-offset-index)))
-	edebug-buffer-outside-point     ; current point in edebug-buffer
-	;; window displaying edebug-buffer
-	(edebug-window-data (nth 3 edebug-data))
-	(edebug-outside-window (selected-window))
-	(edebug-outside-buffer (current-buffer))
-	(edebug-outside-point (point))
- 	(edebug-outside-mark (edebug-mark))
-	edebug-outside-windows		; window or screen configuration
-	edebug-buffer-points
-	
-	edebug-eval-buffer		; declared here so we can kill it below
-	(edebug-eval-result-list (and edebug-eval-list
-				      (edebug-eval-result-list)))
-	edebug-trace-window
-	edebug-trace-window-start
-
-	(edebug-outside-o-a-p overlay-arrow-position)
-	(edebug-outside-o-a-s overlay-arrow-string)
-	(edebug-outside-c-i-e-a cursor-in-echo-area))
-    (unwind-protect
-	(let ((overlay-arrow-position overlay-arrow-position)
-	      (overlay-arrow-string overlay-arrow-string)
-	      (cursor-in-echo-area nil)
-	      ;; any others??
-	      )
-	  (if (not (buffer-name edebug-buffer))
-	      (let ((debug-on-error nil))
-		(error "Buffer defining %s not found" edebug-function)))
-    
-	  (if (eq 'after edebug-arg-mode)
-	      ;; Compute result string now before windows are modified.
-	      (edebug-compute-previous-result edebug-value))
-
-	  (if edebug-save-windows
-	      ;; Save windows now before we modify them.
-	      (setq edebug-outside-windows 
-		    (edebug-current-windows edebug-save-windows)))
-    
-	  (if edebug-save-displayed-buffer-points
-	      (setq edebug-buffer-points (edebug-get-displayed-buffer-points)))
-
-	  ;; First move the edebug buffer point to edebug-point
-	  ;; so that window start doesn't get changed when we display it.
-	  ;; I don't know if this is going to help.
-	  ;;(set-buffer edebug-buffer)
-	  ;;(goto-char edebug-point)
-
-	  ;; If edebug-buffer is not currently displayed,
-	  ;; first find a window for it.
-	  (edebug-pop-to-buffer edebug-buffer (car edebug-window-data))
-	  (setcar edebug-window-data (selected-window))
-
-	  ;; Now display eval list, if any.
-	  ;; This is done after the pop to edebug-buffer 
-	  ;; so that buffer-window correspondence is correct after quitting.
-	  (edebug-eval-display edebug-eval-result-list)
-	  ;; The evaluation list better not have deleted edebug-window-data.
-	  (select-window (car edebug-window-data))
-	  (set-buffer edebug-buffer)
-
-	  (setq edebug-buffer-outside-point (point))
-	  (goto-char edebug-point)
-	    
-	  (if (eq 'before edebug-arg-mode)
-	      ;; Check whether positions are up-to-date.
-	      ;; This assumes point is never before symbol.
-	      (if (not (memq (following-char) '(?\( ?\# ?\` )))
-		  (let ((debug-on-error nil))
-		    (error "Source has changed - reevaluate definition of %s" 
-			   edebug-function)
-		    )))
-
-	  (setcdr edebug-window-data
-		  (edebug-adjust-window (cdr edebug-window-data)))
-	    
-	  ;; Test if there is input, not including keyboard macros.
-	  (if (edebug-input-pending-p) 
-	      (progn
-		(setq edebug-execution-mode 'step
-		      edebug-stop t)
-		(edebug-stop)
-		;;	    (discard-input)		; is this unfriendly??
-		))
-	  ;; Now display arrow based on mode.
-	  (edebug-overlay-arrow)
-	    
-	  (cond
-	   ((eq 'error edebug-arg-mode)
-	    ;; Display error message
-	    (setq edebug-execution-mode 'step)
-	    (edebug-overlay-arrow)
-	    (beep)
-	    (if (eq 'quit (car edebug-value))
-		(message "Quit")
-	      (edebug-report-error edebug-value)))
-	   (edebug-break
-	    (cond
-	     (edebug-global-break
-	      (message "Global Break: %s => %s" 
-		       edebug-global-break-condition
-		       edebug-global-break-result))
-	     (edebug-break-condition
-	      (message "Break: %s => %s" 
-		       edebug-break-condition 
-		       edebug-break-result))
-	     ((not (eq edebug-execution-mode 'Continue-fast))
-	      (message "Break"))
-	     (t)))
-
-	   (t (message "")))
-
-	  (if (eq 'after edebug-arg-mode)
-	      (progn
-		;; Display result of previous evaluation.
-		(if (and edebug-break
-			 (not (eq edebug-execution-mode 'Continue-fast)))
-		    (sit-for 1))	; Show break message.
-		(edebug-previous-result)))
-    
-	  (cond
-	   (edebug-break
-	    (cond
-	     ((eq edebug-execution-mode 'continue) (edebug-sit-for 1))
-	     ((eq edebug-execution-mode 'Continue-fast) (edebug-sit-for 0))
-	     (t (setq edebug-stop t))))
-	   ;; not edebug-break
-	   ((eq edebug-execution-mode 'trace)
-	    (edebug-sit-for 1))		; Force update and pause.
-	   ((eq edebug-execution-mode 'Trace-fast)
-	    (edebug-sit-for 0))		; Force update and continue.
-	   )
-    
-	  (unwind-protect
-	      (if (or edebug-stop
-		      (memq edebug-execution-mode '(step next))
-		      (eq edebug-arg-mode 'error)) 
-		  (progn
-		    ;; (setq edebug-execution-mode 'step)
-		    ;; (edebug-overlay-arrow)	; This doesn't always show up.
-		    (edebug-recursive-edit))) ; <---------- Recursive edit
-
-	    ;; Reset the edebug-window-data to whatever it is now.
-	    (let ((window (if (eq (window-buffer) edebug-buffer)
-			      (selected-window)
-			    (edebug-get-buffer-window edebug-buffer))))
-	      ;; Remember window-start for edebug-buffer, if still displayed.
-	      (if window
-		  (progn
-		    (setcar edebug-window-data window)
-		    (setcdr edebug-window-data (window-start window)))))
-
-	    ;; Save trace window point before restoring outside windows.
-	    ;; Could generalize this for other buffers.
-	    (setq edebug-trace-window (get-buffer-window edebug-trace-buffer))
-	    (if edebug-trace-window
-		(setq edebug-trace-window-start
-		      (and edebug-trace-window 
-			   (window-start edebug-trace-window))))
-
-	    ;; Restore windows before continuing.
-	    (if edebug-save-windows
-		(progn
-		  (edebug-set-windows edebug-outside-windows)
-
-		  ;; Restore displayed buffer points.
-		  ;; Needed even if restoring windows because
-		  ;; window-points are not restored. (should they be??)
-		  (if edebug-save-displayed-buffer-points
-		      (edebug-set-buffer-points edebug-buffer-points))
-
-		  ;; Unrestore trace window's window-point.
-		  (if edebug-trace-window
-		      (set-window-start edebug-trace-window 
-					edebug-trace-window-start))
-
-		  ;; Unrestore edebug-buffer's window-start, if displayed.
-		  (let ((window (car edebug-window-data)))
-		    (if (and window (edebug-window-live-p window) 
-			     (eq (window-buffer) edebug-buffer))
-			(progn
-			  (set-window-start window (cdr edebug-window-data) 
-					    'no-force)
-			  ;; Unrestore edebug-buffer's window-point.
-			  ;; Needed in addition to setting the buffer point
-			  ;; - otherwise quitting doesn't leave point as is.
-			  ;; But this causes point to not be restored at times.
-			  ;; Also, it may not be a visible window.
-			  ;; (set-window-point window edebug-point)
-			  )))
-
-		  ;; Unrestore edebug-buffer's point.   Rerestored below.
-		  ;;  (goto-char edebug-point) ;; in edebug-buffer
-		  )
-	      ;; Since we may be in a save-excursion, in case of quit,
-	      ;; reselect the outside window only.
-	      ;; Only needed if we are not recovering windows??
-	      (if (edebug-window-live-p edebug-outside-window)
-		  (select-window edebug-outside-window))
-	      )				; if edebug-save-windows
-
-	    ;; Restore current buffer always, in case application needs it.
-	    (set-buffer edebug-outside-buffer)
-	    ;; Restore point, and mark.
-	    ;; Needed even if restoring windows because
-	    ;; that doesn't restore point and mark in the current buffer.
-	    ;; But don't restore point if edebug-buffer is current buffer.
-	    (if (not (eq edebug-buffer edebug-outside-buffer))
-		(goto-char edebug-outside-point))
-	    (if (marker-buffer (edebug-mark-marker))
-		;; Does zmacs-regions need to be nil while doing set-marker?
-		(set-marker (edebug-mark-marker) edebug-outside-mark))
-	    )				; unwind-protect
-	  ;; None of the following is done if quit or signal occurs.
-
-	  ;; Restore edebug-buffer's outside point.
-	  ;;    (edebug-trace "restore edebug-buffer point: %s" 
-	  ;;		  edebug-buffer-outside-point)
-	  (let ((current-buffer (current-buffer)))
-	    (set-buffer edebug-buffer)
-	    (goto-char edebug-buffer-outside-point)
-	    (set-buffer current-buffer))
-	  ;; ... nothing more.
-	  )
-      ;; Reset global variables to outside values in case they were changed.
-      (setq
-       overlay-arrow-position edebug-outside-o-a-p
-       overlay-arrow-string edebug-outside-o-a-s
-       cursor-in-echo-area edebug-outside-c-i-e-a)
-      )))
-
-
-(defvar edebug-number-of-recursions 0)
-;; Number of recursive edits started by edebug.
-;; Should be 0 at the top level.
-
-(defvar edebug-recursion-depth 0)
-;; Value of recursion-depth when edebug was called.
-
-;; Dynamically declared unbound vars
-(defvar edebug-outside-match-data) ; match data outside of edebug
-(defvar edebug-backtrace-buffer) ; each recursive edit gets its own
-(defvar edebug-inside-windows) 
-(defvar edebug-interactive-p)
-
-(defvar edebug-outside-map)
-(defvar edebug-outside-standard-output)
-(defvar edebug-outside-standard-input)
-(defvar edebug-outside-last-command-char)
-(defvar edebug-outside-last-command)
-(defvar edebug-outside-this-command)
-(defvar edebug-outside-last-input-char)
-
-;; Note: here we have defvars for variables that are
-;; built-in in certain versions.
-;; Each defvar makes a difference
-;; in versions where the variable is *not* built-in.
-
-;; Emacs 18
-(defvar edebug-outside-unread-command-char)
-
-;; Lucid Emacs
-(defvar edebug-outside-unread-command-event)  ;; like unread-command-events
-(defvar unread-command-event nil)
-
-;; Emacs 19.
-(defvar edebug-outside-last-command-event)
-(defvar edebug-outside-unread-command-events)
-(defvar edebug-outside-last-input-event)
-(defvar edebug-outside-last-event-frame)
-(defvar edebug-outside-last-nonmenu-event)
-(defvar edebug-outside-track-mouse)
-
-;; Disable byte compiler warnings about unread-command-char and -event
-;; (maybe works with byte-compile-version 2.22 at least)
-(defvar edebug-unread-command-char-warning)
-(defvar edebug-unread-command-event-warning)
-(eval-when-compile
-  (setq edebug-unread-command-char-warning
-	(get 'unread-command-char 'byte-obsolete-variable))
-  (put 'unread-command-char 'byte-obsolete-variable nil)
-  (setq edebug-unread-command-event-warning
-	(get 'unread-command-event 'byte-obsolete-variable))
-  (put 'unread-command-event 'byte-obsolete-variable nil))
-
-(defun edebug-recursive-edit ()
-  ;; Start up a recursive edit inside of edebug.
-  ;; The current buffer is the edebug-buffer, which is put into edebug-mode.
-  ;; Assume that none of the variables below are buffer-local.
-  (let ((edebug-buffer-read-only buffer-read-only)
-	;; match-data must be done in the outside buffer
-	(edebug-outside-match-data
-	 (save-excursion  ; might be unnecessary now??
-	   (set-buffer edebug-outside-buffer)  ; in case match buffer different
-	   (match-data)))
-
-	;;(edebug-number-of-recursions (1+ edebug-number-of-recursions))
-	(edebug-recursion-depth (recursion-depth))
-	edebug-entered			; bind locally to nil
-	(edebug-interactive-p nil)      ; again non-interactive
-	edebug-backtrace-buffer		; each recursive edit gets its own
-	;; The window configuration may be saved and restored
-	;; during a recursive-edit
-	edebug-inside-windows
-
-	(edebug-outside-map (current-local-map))
-
-	(edebug-outside-standard-output standard-output)
-	(edebug-outside-standard-input standard-input)
-	(edebug-outside-defining-kbd-macro defining-kbd-macro)
-
-	(edebug-outside-last-command-char last-command-char)
-	(edebug-outside-last-command last-command)
-	(edebug-outside-this-command this-command)
-	(edebug-outside-last-input-char last-input-char)
-
-	(edebug-outside-unread-command-char unread-command-char)
-
-	(edebug-outside-last-input-event last-input-event)
-	(edebug-outside-last-command-event last-command-event)
-	(edebug-outside-unread-command-event unread-command-event)
-	(edebug-outside-unread-command-events unread-command-events)
-	(edebug-outside-last-event-frame last-event-frame)
-	(edebug-outside-last-nonmenu-event last-nonmenu-event)
-	(edebug-outside-track-mouse track-mouse)
-	)
-
-    (unwind-protect
-	(let (
-	      ;; Declare global values local but using the same global value.
-	      ;; We could set these to the values for previous edebug call.
-	      (last-command-char last-command-char)
-	      (last-command last-command) 
-	      (this-command this-command)
-	      (last-input-char last-input-char)
-
-	      ;; Assume no edebug command sets unread-command-char.
-	      (unread-command-char -1)
-
-	      ;; More for Emacs 19
-	      (last-input-event nil)
-	      (last-command-event nil)
-	      (unread-command-event nil);; lemacs
-	      (unread-command-events nil)
-	      (last-event-frame nil)
-	      (last-nonmenu-event nil)
-	      (track-mouse nil)
-
-	      ;; Bind again to outside values.
-	      (debug-on-error edebug-outside-debug-on-error)
-	      (debug-on-quit edebug-outside-debug-on-quit)
-
-	      ;; Don't keep defining a kbd macro.
-	      (defining-kbd-macro 
-		(if edebug-continue-kbd-macro defining-kbd-macro))
-
-	      ;; others??
-	      )
-
-	  (if (fboundp 'zmacs-deactivate-region);; for lemacs
-	      (zmacs-deactivate-region))
-	  (if (and (eq edebug-execution-mode 'go)
-		   (not (memq edebug-arg-mode '(after error))))
-	      (message "Break"))
-
-	  (setq buffer-read-only t)
-	  (setq signal-hook-function nil)
-
-	  (edebug-mode)
-	  (unwind-protect
-	      (recursive-edit)		;  <<<<<<<<<< Recursive edit
-
-	    ;; Do the following, even if quit occurs.
-	    (setq signal-hook-function 'edebug-signal)
-	    (if edebug-backtrace-buffer
-		(kill-buffer edebug-backtrace-buffer))
-	    ;; Could be an option to keep eval display up.
-	    (if edebug-eval-buffer (kill-buffer edebug-eval-buffer))
-
-	    ;; Remember selected-window after recursive-edit.
-	    ;;      (setq edebug-inside-window (selected-window))
-
-	    (store-match-data edebug-outside-match-data)
-
-	    ;; Recursive edit may have changed buffers,
-	    ;; so set it back before exiting let.
-	    (if (buffer-name edebug-buffer) ; if it still exists
-		(progn
-		  (set-buffer edebug-buffer)
-		  (if (memq edebug-execution-mode '(go Go-nonstop))
-		      (edebug-overlay-arrow))
-		  (setq buffer-read-only edebug-buffer-read-only)
-		  (use-local-map edebug-outside-map)
-		  )
-	      ;; gotta have a buffer to let its buffer local variables be set
-	      (get-buffer-create " bogus edebug buffer"))
-	    ));; inner let
-
-      ;; Reset global vars to outside values, in case they have been changed.
-      (setq 
-       last-command-char edebug-outside-last-command-char
-       last-command-event edebug-outside-last-command-event
-       last-command edebug-outside-last-command
-       this-command edebug-outside-this-command
-       unread-command-char edebug-outside-unread-command-char
-       unread-command-event edebug-outside-unread-command-event
-       unread-command-events edebug-outside-unread-command-events
-       last-input-char edebug-outside-last-input-char
-       last-input-event edebug-outside-last-input-event
-       last-event-frame edebug-outside-last-event-frame
-       last-nonmenu-event edebug-outside-last-nonmenu-event
-       track-mouse edebug-outside-track-mouse
-
-       standard-output edebug-outside-standard-output
-       standard-input edebug-outside-standard-input
-       defining-kbd-macro edebug-outside-defining-kbd-macro
-       ))
-    ))
-
-
-;;; Display related functions
-
-(defun edebug-adjust-window (old-start)
-  ;; If pos is not visible, adjust current window to fit following context.
-;;;  (message "window: %s old-start: %s window-start: %s pos: %s" 
-;;;	   (selected-window) old-start (window-start) (point)) (sit-for 5)
-  (if (not (pos-visible-in-window-p))
-      (progn
-	;; First try old-start
-	(if old-start
-	    (set-window-start (selected-window) old-start))
-	(if (not (pos-visible-in-window-p))
-	    (progn
-;;	(message "resetting window start") (sit-for 2)
-	(set-window-start
-	 (selected-window)
-	 (save-excursion
-	   (forward-line
-	    (if (< (point) (window-start)) -1	; one line before if in back
-	      (- (/ (window-height) 2)) ; center the line moving forward
-	      ))
-	   (beginning-of-line)
-	   (point)))))))
-  (window-start))
-  
-
-
-(defconst edebug-arrow-alist
-  '((Continue-fast . "=")
-    (Trace-fast . "-")
-    (continue . ">")
-    (trace . "->")
-    (step . "=>")
-    (next . "=>")
-    (go . "<>")
-    (Go-nonstop . "..")  ; not used
-    )
-  "Association list of arrows for each edebug mode.")
-
-(defun edebug-overlay-arrow ()
-  ;; Set up the overlay arrow at beginning-of-line in current buffer.
-  ;; The arrow string is derived from edebug-arrow-alist and 
-  ;; edebug-execution-mode.
-  (let ((pos (save-excursion (beginning-of-line) (point))))
-    (setq overlay-arrow-string
-	  (cdr (assq edebug-execution-mode edebug-arrow-alist)))
-    (setq overlay-arrow-position (make-marker))
-    (set-marker overlay-arrow-position pos (current-buffer))))
-
-
-(defun edebug-toggle-save-all-windows ()
-  "Toggle the saving and restoring of all windows.
-Also, each time you toggle it on, the inside and outside window
-configurations become the same as the current configuration."
-  (interactive)
-  (setq edebug-save-windows (not edebug-save-windows))
-  (if edebug-save-windows
-      (setq edebug-inside-windows
-	    (setq edebug-outside-windows
-		  (edebug-current-windows
-		   edebug-save-windows))))
-  (message "Window saving is %s for all windows."
-	   (if edebug-save-windows "on" "off")))
-
-(defmacro edebug-changing-windows (&rest body)
-  (` (let ((window (selected-window)))
-       (setq edebug-inside-windows (edebug-current-windows t))
-       (edebug-set-windows edebug-outside-windows)
-       (,@ body) ;; Code to change edebug-save-windows
-       (setq edebug-outside-windows (edebug-current-windows 
-				     edebug-save-windows))
-       ;; Problem: what about outside windows that are deleted inside?
-       (edebug-set-windows edebug-inside-windows))))
-
-(defun edebug-toggle-save-selected-window ()
-  "Toggle the saving and restoring of the selected window. 
-Also, each time you toggle it on, the inside and outside window
-configurations become the same as the current configuration."
-  (interactive)
-  (cond
-   ((eq t edebug-save-windows)
-    ;; Save all outside windows except the selected one.
-    ;; Remove (selected-window) from outside-windows.
-    (edebug-changing-windows
-     (setq edebug-save-windows (delq window (edebug-window-list)))))
-
-   ((memq (selected-window) edebug-save-windows)
-    (setq edebug-outside-windows
-	  (delq (assq (selected-window) edebug-outside-windows)
-		edebug-outside-windows))
-    (setq edebug-save-windows
-	  (delq (selected-window) edebug-save-windows)))
-   (t					; Save a new window.
-    (edebug-changing-windows
-     (setq edebug-save-windows (cons window edebug-save-windows)))))
-
-  (message "Window saving is %s for %s."
-	   (if (memq (selected-window) edebug-save-windows)
-	       "on" "off")
-	   (selected-window)))
-
-(defun edebug-toggle-save-windows (arg)
-  "Toggle the saving and restoring of windows.
-With prefix, toggle for just the selected window.
-Otherwise, toggle for all windows."
-  (interactive "P")
-  (if arg
-      (edebug-toggle-save-selected-window)
-    (edebug-toggle-save-all-windows)))
-
-
-(defun edebug-where ()
-  "Show the debug windows and where we stopped in the program."
-  (interactive)
-  (if (not edebug-active)
-      (error "Edebug is not active"))
-  ;; Restore the window configuration to what it last was inside.
-  ;; But it is not always set.   - experiment
-  ;;(if edebug-inside-windows
-  ;;  (edebug-set-windows edebug-inside-windows))
-  (edebug-pop-to-buffer edebug-buffer)
-  (goto-char edebug-point))
-
-(defun edebug-view-outside ()
-  "Change to the outside window configuration."
-  (interactive)
-  (if (not edebug-active)
-      (error "Edebug is not active"))
-  (setq edebug-inside-windows 
-	(edebug-current-windows edebug-save-windows))
-  (edebug-set-windows edebug-outside-windows)
-  (goto-char edebug-outside-point)
-  (message "Window configuration outside of Edebug.  Return with %s"
-	   (substitute-command-keys "\\<global-map>\\[edebug-where]")))
-
-
-(defun edebug-bounce-point (arg)
-  "Bounce the point in the outside current buffer.
-If prefix arg is supplied, sit for that many seconds before returning.
-The default is one second."
-  (interactive "p")
-  (if (not edebug-active)
-      (error "Edebug is not active"))
-  (save-excursion
-    ;; If the buffer's currently displayed, avoid set-window-configuration.
-    (save-window-excursion
-      (edebug-pop-to-buffer edebug-outside-buffer)
-      (goto-char edebug-outside-point)
-      (message "Current buffer: %s Point: %s Mark: %s" 
-	       (current-buffer) (point) 
-	       (if (marker-buffer (edebug-mark-marker))
-		   (marker-position (edebug-mark-marker)) "<not set>"))
-      (edebug-sit-for arg)
-      (edebug-pop-to-buffer edebug-buffer (car edebug-window-data)))))
-
-
-;; Joe Wells, here is a start at your idea of adding a buffer to the internal 
-;; display list.  Still need to use this list in edebug-display.
-
-'(defvar edebug-display-buffer-list nil
-  "List of buffers that edebug will display when it is active.")
-
-'(defun edebug-display-buffer (buffer)
-  "Toggle display of a buffer inside of edebug."
-  (interactive "bBuffer: ")
-  (let ((already-displaying (memq buffer edebug-display-buffer-list)))
-    (setq edebug-display-buffer-list
-	  (if already-displaying
-	      (delq buffer edebug-display-buffer-list)
-	    (cons buffer edebug-display-buffer-list)))
-    (message "Displaying %s %s" buffer
-	     (if already-displaying "off" "on"))))
-
-;;; Breakpoint related functions
-
-(defun edebug-find-stop-point ()
-  ;; Return (function . index) of the nearest edebug stop point.
-  (let* ((edebug-def-name (edebug-form-data-symbol))
-	 (edebug-data
-	   (let ((data (get edebug-def-name 'edebug)))
-	     (if (or (null data) (markerp data))
-		 (error "%s is not instrumented for Edebug" edebug-def-name))
-	     data))  ; we could do it automatically, if data is a marker.
-	 ;; pull out parts of edebug-data.
-	 (edebug-def-mark (car edebug-data))
-	 ;; (edebug-breakpoints (car (cdr edebug-data)))
-
-	 (offset-vector (nth 2 edebug-data))
-	 (offset (- (save-excursion
-		      (if (looking-at "[ \t]")
-			  ;; skip backwards until non-whitespace, or bol
-			  (skip-chars-backward " \t"))
-		      (point))
-		    edebug-def-mark))
-	 len i)
-    ;; the offsets are in order so we can do a linear search
-    (setq len (length offset-vector))
-    (setq i 0)
-    (while (and (< i len) (> offset (aref offset-vector i)))
-      (setq i (1+ i)))
-    (if (and (< i len)
-	     (<= offset (aref offset-vector i)))
-	;; return the relevant info
-	(cons edebug-def-name i)
-      (message "Point is not on an expression in %s."
-	       edebug-def-name)
-      )))
-
-
-(defun edebug-next-breakpoint ()
-  "Move point to the next breakpoint, or first if none past point."
-  (interactive)
-  (let ((edebug-stop-point (edebug-find-stop-point)))
-    (if edebug-stop-point
-	(let* ((edebug-def-name (car edebug-stop-point))
-	       (index (cdr edebug-stop-point))
-	       (edebug-data (get edebug-def-name 'edebug))
-	       
-	       ;; pull out parts of edebug-data
-	       (edebug-def-mark (car edebug-data))
-	       (edebug-breakpoints (car (cdr edebug-data)))
-	       (offset-vector (nth 2 edebug-data))
-	       breakpoint)
-	  (if (not edebug-breakpoints)
-	      (message "No breakpoints in this function.")
-	    (let ((breaks edebug-breakpoints))
-	      (while (and breaks
-			  (<= (car (car breaks)) index))
-		(setq breaks (cdr breaks)))
-	      (setq breakpoint
-		    (if breaks
-			(car breaks)
-		      ;; goto the first breakpoint
-		      (car edebug-breakpoints)))
-	      (goto-char (+ edebug-def-mark
-			    (aref offset-vector (car breakpoint))))
-	      
-	      (message "%s"
-		       (concat (if (nth 2 breakpoint)
-				   "Temporary " "")
-			       (if (car (cdr breakpoint))
-				   (format "Condition: %s"
-					   (edebug-safe-prin1-to-string
-					    (car (cdr breakpoint))))
-				 "")))
-	      ))))))
-
-
-(defun edebug-modify-breakpoint (flag &optional condition temporary)
-  "Modify the breakpoint for the form at point or after it according
-to FLAG: set if t, clear if nil.  Then move to that point.
-If CONDITION or TEMPORARY are non-nil, add those attributes to
-the breakpoint.  "  
-  (let ((edebug-stop-point (edebug-find-stop-point)))
-    (if edebug-stop-point
-	(let* ((edebug-def-name (car edebug-stop-point))
-	       (index (cdr edebug-stop-point))
-	       (edebug-data (get edebug-def-name 'edebug))
-	       
-	       ;; pull out parts of edebug-data
-	       (edebug-def-mark (car edebug-data))
-	       (edebug-breakpoints (car (cdr edebug-data)))
-	       (offset-vector (nth 2 edebug-data))
-	       present)
-	  ;; delete it either way
-	  (setq present (assq index edebug-breakpoints))
-	  (setq edebug-breakpoints (delq present edebug-breakpoints))
-	  (if flag
-	      (progn
-		;; add it to the list and resort
-		(setq edebug-breakpoints
-		      (edebug-sort-alist
-		       (cons
-			(list index condition temporary)
-			edebug-breakpoints) '<))
-		(if condition
-		    (message "Breakpoint set in %s with condition: %s"
-			     edebug-def-name condition)
-		  (message "Breakpoint set in %s" edebug-def-name)))
-	    (if present
-		(message "Breakpoint unset in %s" edebug-def-name)
-	      (message "No breakpoint here")))
-	  
-	  (setcar (cdr edebug-data) edebug-breakpoints)
-	  (goto-char (+ edebug-def-mark (aref offset-vector index)))
-	  ))))
-
-(defun edebug-set-breakpoint (arg)
-  "Set the breakpoint of nearest sexp.
-With prefix argument, make it a temporary breakpoint."
-  (interactive "P")
-  (edebug-modify-breakpoint t nil arg))
-
-(defun edebug-unset-breakpoint ()
-  "Clear the breakpoint of nearest sexp."
-  (interactive)
-  (edebug-modify-breakpoint nil))
-
-
-;; For emacs 18, no read-expression-history
-(defun edebug-set-conditional-breakpoint (arg condition)
-  "Set a conditional breakpoint at nearest sexp.
-The condition is evaluated in the outside context.
-With prefix argument, make it a temporary breakpoint."
-  ;; (interactive "P\nxCondition: ")
-  (interactive 
-   (list
-    current-prefix-arg
-    ;; Edit previous condition as follows, but it is cumbersome:
-    (let ((edebug-stop-point (edebug-find-stop-point)))
-      (if edebug-stop-point
-          (let* ((edebug-def-name (car edebug-stop-point))
-                 (index (cdr edebug-stop-point))
-                 (edebug-data (get edebug-def-name 'edebug))
-                 (edebug-breakpoints (car (cdr edebug-data)))
-                 (edebug-break-data (assq index edebug-breakpoints))
-                 (edebug-break-condition (car (cdr edebug-break-data))))
-            (read-minibuffer 
-             (format "Condition in %s: " edebug-def-name)
-             (if edebug-break-condition
-                 (format "%s" edebug-break-condition)
-               (format ""))))))))
-  (edebug-modify-breakpoint t condition arg))
-
-
-(defun edebug-set-global-break-condition (expression)
-  (interactive (list (read-minibuffer 
-		      "Global Condition: " 
-		      (format "%s" edebug-global-break-condition))))
-  (setq edebug-global-break-condition expression))
-
-
-;;; Mode switching functions
-
-(defun edebug-set-mode (mode shortmsg msg)
-  ;; Set the edebug mode to MODE.
-  ;; Display SHORTMSG, or MSG if not within edebug.
-  (if (eq (1+ edebug-recursion-depth) (recursion-depth))
-      (progn
-	(setq edebug-execution-mode mode)
-	(message shortmsg)
-	;; Continue execution
-	(exit-recursive-edit))
-    ;; This is not terribly useful!!
-    (setq edebug-next-execution-mode mode)
-    (message msg)))
-
-
-(defalias 'edebug-step-through-mode 'edebug-step-mode)
-
-(defun edebug-step-mode ()
-  "Proceed to next stop point."
-  (interactive)
-  (edebug-set-mode 'step "" "Edebug will stop at next stop point."))
-
-(defun edebug-next-mode ()
-  "Proceed to next `after' stop point."
-  (interactive)
-  (edebug-set-mode 'next "" "Edebug will stop after next eval."))
-
-(defun edebug-go-mode (arg)
-  "Go, evaluating until break.
-With prefix ARG, set temporary break at current point and go."
-  (interactive "P")
-  (if arg
-      (edebug-set-breakpoint t))
-  (edebug-set-mode 'go "Go..." "Edebug will go until break."))
-
-(defun edebug-Go-nonstop-mode ()
-  "Go, evaluating without debugging."
-  (interactive)
-  (edebug-set-mode 'Go-nonstop "Go-Nonstop..."
-		   "Edebug will not stop at breaks."))
-
-
-(defun edebug-trace-mode ()
-  "Begin trace mode."
-  (interactive)
-  (edebug-set-mode 'trace "Tracing..." "Edebug will trace with pause."))
-
-(defun edebug-Trace-fast-mode ()
-  "Trace with no wait at each step."
-  (interactive)
-  (edebug-set-mode 'Trace-fast
-		   "Trace fast..." "Edebug will trace without pause."))
-
-(defun edebug-continue-mode ()
-  "Begin continue mode."
-  (interactive)
-  (edebug-set-mode 'continue "Continue..."
-		   "Edebug will pause at breakpoints."))
-
-(defun edebug-Continue-fast-mode ()
-  "Trace with no wait at each step."
-  (interactive)
-  (edebug-set-mode 'Continue-fast "Continue fast..."
-		   "Edebug will stop and go at breakpoints."))
-
-;; ------------------------------------------------------------
-;; The following use the mode changing commands and breakpoints.
-
-
-(defun edebug-goto-here ()
-  "Proceed to this stop point."
-  (interactive)
-  (edebug-go-mode t))
-
-
-(defun edebug-stop ()
-  "Stop execution and do not continue.
-Useful for exiting from trace or continue loop."
-  (interactive)
-  (message "Stop"))
-
-
-'(defun edebug-forward ()
-  "Proceed to the exit of the next expression to be evaluated."
-  (interactive)
-  (edebug-set-mode 
-   'forward "Forward"
-   "Edebug will stop after exiting the next expression."))
-
-
-(defun edebug-forward-sexp (arg)
-  "Proceed from the current point to the end of the ARGth sexp ahead.
-If there are not ARG sexps ahead, then do edebug-step-out."
-  (interactive "p")
-  (condition-case nil
-      (let ((parse-sexp-ignore-comments t))
-	;; Call forward-sexp repeatedly until done or failure.
-	(forward-sexp arg)
-	(edebug-go-mode t))
-    (error
-     (edebug-step-out)
-     )))
-
-(defun edebug-step-out ()
-  "Proceed from the current point to the end of the containing sexp.
-If there is no containing sexp that is not the top level defun,
-go to the end of the last sexp, or if that is the same point, then step."
-  (interactive)
-  (condition-case nil
-      (let ((parse-sexp-ignore-comments t))
-	(up-list 1)
-	(save-excursion
-	  ;; Is there still a containing expression?
-	  (up-list 1))
-	(edebug-go-mode t))
-    (error
-     ;; At top level - 1, so first check if there are more sexps at this level.
-     (let ((start-point (point)))
-;;       (up-list 1)
-       (down-list -1)
-       (if (= (point) start-point)
-	   (edebug-step-mode)	; No more at this level, so step.
-	 (edebug-go-mode t)
-	 )))))
-
-(defun edebug-instrument-function (func)
-  ;; Func should be a function symbol.
-  ;; Return the function symbol, or nil if not instrumented.
-  (let ((func-marker))
-    (setq func-marker (get func 'edebug))
-    (cond
-     ((markerp func-marker)
-      ;; It is uninstrumented, so instrument it.
-      (save-excursion
-	(set-buffer (marker-buffer func-marker))
-	(goto-char func-marker)
-	(edebug-eval-top-level-form)
-	func))
-     ((consp func-marker)
-      (message "%s is already instrumented." func)
-      func)
-     (t 
-      ;; We could try harder, e.g. do a tags search.
-      (error "Don't know where %s is defined" func)
-      nil))))
-
-(defun edebug-instrument-callee ()
-  "Instrument the definition of the function or macro about to be called.  
-Do this when stopped before the form or it will be too late.
-One side effect of using this command is that the next time the
-function or macro is called, Edebug will be called there as well."
-  (interactive)
-  (if (not (looking-at "\("))
-      (error "You must be before a list form")
-    (let ((func
-	   (save-excursion
-	     (down-list 1)
-	     (if (looking-at "\(")
-		 (edebug-form-data-name
-		  (edebug-get-form-data-entry (point)))
-	       (edebug-original-read (current-buffer))))))
-      (edebug-instrument-function func))))
-
-
-(defun edebug-step-in ()
-  "Step into the definition of the function or macro about to be called.  
-This first does `edebug-instrument-callee' to ensure that it is 
-instrumented.  Then it does `edebug-on-entry' and switches to `go' mode."
-  (interactive)
-  (let ((func (edebug-instrument-callee)))
-    (if func
-	(progn
-	  (edebug-on-entry func 'temp)
-	  (edebug-go-mode nil)))))
-
-(defun edebug-on-entry (function &optional flag)
-  "Cause Edebug to stop when FUNCTION is called.
-With prefix argument, make this temporary so it is automatically
-cancelled the first time the function is entered."
-  (interactive "aEdebug on entry to: \nP")
-  ;; Could store this in the edebug data instead.
-  (put function 'edebug-on-entry (if flag 'temp t)))
-
-(defun cancel-edebug-on-entry (function)
-  (interactive "aEdebug on entry to: ")
-  (put function 'edebug-on-entry nil))
-
-    
-(if (not (fboundp 'edebug-original-debug-on-entry))
-    (fset 'edebug-original-debug-on-entry (symbol-function 'debug-on-entry)))
-'(fset 'debug-on-entry 'edebug-debug-on-entry)  ;; Should we do this?
-;; Also need edebug-cancel-debug-on-entry
-
-'(defun edebug-debug-on-entry (function)
-  "Request FUNCTION to invoke debugger each time it is called.
-If the user continues, FUNCTION's execution proceeds.
-Works by modifying the definition of FUNCTION,
-which must be written in Lisp, not predefined.
-Use `cancel-debug-on-entry' to cancel the effect of this command.
-Redefining FUNCTION also does that.
-
-This version is from Edebug.  If the function is instrumented for
-Edebug, it calls `edebug-on-entry'"
-  (interactive "aDebug on entry (to function): ")
-  (let ((func-data (get function 'edebug)))
-    (if (or (null func-data) (markerp func-data))
-	(edebug-original-debug-on-entry function)
-      (edebug-on-entry function))))
-
-
-(defun edebug-top-level-nonstop ()
-  "Set mode to Go-nonstop, and exit to top-level.
-This is useful for exiting even if unwind-protect code may be executed."
-  (interactive)
-  (setq edebug-execution-mode 'Go-nonstop)
-  (top-level))
-
-
-;;(defun edebug-exit-out ()
-;;  "Go until the current function exits."
-;;  (interactive)
-;;  (edebug-set-mode 'exiting "Exit..."))
-
-
-;;; The following initial mode setting definitions are not used yet.
-
-'(defconst edebug-initial-mode-alist
-  '((edebug-Continue-fast . Continue-fast)
-    (edebug-Trace-fast . Trace-fast)
-    (edebug-continue . continue)
-    (edebug-trace . trace)
-    (edebug-go . go)
-    (edebug-step-through . step)
-    (edebug-Go-nonstop . Go-nonstop)
-    )
-  "Association list between commands and the modes they set.")
-
-
-'(defun edebug-set-initial-mode ()
-  "Ask for the initial mode of the enclosing function.
-The mode is requested via the key that would be used to set the mode in
-edebug-mode."
-  (interactive)
-  (let* ((this-function (edebug-which-function))
-	 (keymap (if (eq edebug-mode-map (current-local-map))
-		     edebug-mode-map))
-	 (old-mode (or (get this-function 'edebug-initial-mode)
-		       edebug-initial-mode))
-	 (key (read-key-sequence
-	       (format
-		"Change initial edebug mode for %s from %s (%s) to (enter key): "
-		       this-function
-		       old-mode
-		       (where-is-internal
-			(car (rassq old-mode edebug-initial-mode-alist))
-			keymap 'firstonly
-			))))
-	 (mode (cdr (assq (key-binding key) edebug-initial-mode-alist)))
-	 )
-    (if (and mode
-	     (or (get this-function 'edebug-initial-mode)
-		 (not (eq mode edebug-initial-mode))))
-	(progn
-	  (put this-function 'edebug-initial-mode mode)
-	  (message "Initial mode for %s is now: %s"
-		   this-function mode))
-      (error "Key must map to one of the mode changing commands")
-      )))
-
-;;; Evaluation of expressions
-
-(def-edebug-spec edebug-outside-excursion t)
-
-(defmacro edebug-outside-excursion (&rest body)
-  "Evaluate an expression list in the outside context.
-Return the result of the last expression."
-  (` (save-excursion			; of current-buffer
-       (if edebug-save-windows
-	   (progn
-	     ;; After excursion, we will 
-	     ;; restore to current window configuration.
-	     (setq edebug-inside-windows
-		   (edebug-current-windows edebug-save-windows))
-	     ;; Restore outside windows.
-	     (edebug-set-windows edebug-outside-windows)))
-
-       (set-buffer edebug-buffer)  ; why?
-       ;; (use-local-map edebug-outside-map)
-       (store-match-data edebug-outside-match-data)
-       ;; Restore outside context.
-       (let (;; (edebug-inside-map (current-local-map)) ;; restore map??
-	     (last-command-char edebug-outside-last-command-char)
-	     (last-command-event edebug-outside-last-command-event)
-	     (last-command edebug-outside-last-command)
-	     (this-command edebug-outside-this-command)
-	     (unread-command-char edebug-outside-unread-command-char)
-	     (unread-command-event edebug-outside-unread-command-event)
-	     (unread-command-events edebug-outside-unread-command-events)
-	     (last-input-char edebug-outside-last-input-char)
-	     (last-input-event edebug-outside-last-input-event)
-	     (last-event-frame edebug-outside-last-event-frame)
-	     (last-nonmenu-event edebug-outside-last-nonmenu-event)
-	     (track-mouse edebug-outside-track-mouse)
-	     (standard-output edebug-outside-standard-output)
-	     (standard-input edebug-outside-standard-input)
-
-	     (executing-kbd-macro edebug-outside-executing-macro)
-	     (defining-kbd-macro edebug-outside-defining-kbd-macro)
-	     (pre-command-hook edebug-outside-pre-command-hook)
-	     (post-command-hook edebug-outside-post-command-hook)
-
-	     ;; See edebug-display
-	     (overlay-arrow-position edebug-outside-o-a-p)
-	     (overlay-arrow-string edebug-outside-o-a-s)
-	     (cursor-in-echo-area edebug-outside-c-i-e-a)
-	     )
-	 (unwind-protect
-	     (save-excursion		; of edebug-buffer
-	       (set-buffer edebug-outside-buffer)
-	       (goto-char edebug-outside-point)
-	       (if (marker-buffer (edebug-mark-marker))
-		   (set-marker (edebug-mark-marker) edebug-outside-mark))
-	       (,@ body))
-
-	   ;; Back to edebug-buffer.  Restore rest of inside context.
-	   ;; (use-local-map edebug-inside-map)
-	   (if edebug-save-windows
-	       ;; Restore inside windows.
-	       (edebug-set-windows edebug-inside-windows))
-
-	   ;; Save values that may have been changed.
-	   (setq 
-	    edebug-outside-last-command-char last-command-char
-	    edebug-outside-last-command-event last-command-event
-	    edebug-outside-last-command last-command
-	    edebug-outside-this-command this-command
-	    edebug-outside-unread-command-char unread-command-char
-	    edebug-outside-unread-command-event unread-command-event
-	    edebug-outside-unread-command-events unread-command-events
-	    edebug-outside-last-input-char last-input-char
-	    edebug-outside-last-input-event last-input-event
-	    edebug-outside-last-event-frame last-event-frame
-	    edebug-outside-last-nonmenu-event last-nonmenu-event
-	    edebug-outside-track-mouse track-mouse
-	    edebug-outside-standard-output standard-output
-	    edebug-outside-standard-input standard-input
-
-	    edebug-outside-executing-macro executing-kbd-macro
-	    edebug-outside-defining-kbd-macro defining-kbd-macro
-	    edebug-outside-pre-command-hook pre-command-hook
-	    edebug-outside-post-command-hook post-command-hook
-
-	    edebug-outside-o-a-p overlay-arrow-position
-	    edebug-outside-o-a-s overlay-arrow-string
-	    edebug-outside-c-i-e-a cursor-in-echo-area
-	    )))				; let
-       )))
-
-(defvar cl-debug-env nil) ;; defined in cl; non-nil when lexical env used.
-
-(defun edebug-eval (edebug-expr)
-  ;; Are there cl lexical variables active?
-  (if cl-debug-env
-      (eval (cl-macroexpand-all edebug-expr cl-debug-env))
-    (eval edebug-expr)))
-
-(defun edebug-safe-eval (edebug-expr)
-  ;; Evaluate EXPR safely. 
-  ;; If there is an error, a string is returned describing the error.
-  (condition-case edebug-err
-      (edebug-eval edebug-expr)
-    (error (edebug-format "%s: %s"  ;; could 
-			  (get (car edebug-err) 'error-message)
-			  (car (cdr edebug-err))))))
-
-;;; Printing
-
-;; Replace printing functions.
-
-;; obsolete names
-(defalias 'edebug-install-custom-print-funcs 'edebug-install-custom-print)
-(defalias 'edebug-reset-print-funcs 'edebug-uninstall-custom-print)
-(defalias 'edebug-uninstall-custom-print-funcs 'edebug-uninstall-custom-print)
-
-(defun edebug-install-custom-print ()
-  "Replace print functions used by Edebug with custom versions."
-  ;; Modifying the custom print functions, or changing print-length,
-  ;; print-level, print-circle, custom-print-list or custom-print-vector
-  ;; have immediate effect.
-  (interactive)
-  (require 'cust-print)
-  (defalias 'edebug-prin1 'custom-prin1)
-  (defalias 'edebug-print 'custom-print)
-  (defalias 'edebug-prin1-to-string 'custom-prin1-to-string)
-  (defalias 'edebug-format 'custom-format)
-  (defalias 'edebug-message 'custom-message)
-  "Installed")
-
-(eval-and-compile
-  (defun edebug-uninstall-custom-print ()
-    "Replace edebug custom print functions with internal versions."
-    (interactive)
-    (defalias 'edebug-prin1 'prin1)
-    (defalias 'edebug-print 'print)
-    (defalias 'edebug-prin1-to-string 'prin1-to-string)
-    (defalias 'edebug-format 'format)
-    (defalias 'edebug-message 'message)
-    "Uninstalled")
-
-  ;; Default print functions are the same as Emacs'.
-  (edebug-uninstall-custom-print))
-
-
-(defun edebug-report-error (edebug-value)
-  ;; Print an error message like command level does.
-  ;; This also prints the error name if it has no error-message.
-  (message "%s: %s" 
-	   (or (get (car edebug-value) 'error-message)
-	       (format "peculiar error (%s)" (car edebug-value)))
-	   (mapconcat (function (lambda (edebug-arg) 
-				  ;; continuing after an error may
-				  ;; complain about edebug-arg. why??
-				  (prin1-to-string edebug-arg)))
-		      (cdr edebug-value) ", ")))
-
-;; Define here in case they are not already defined.
-(defvar print-level nil)
-(defvar print-circle nil)
-(defvar print-readably) ;; defined by lemacs
-;; Alternatively, we could change the definition of 
-;; edebug-safe-prin1-to-string to only use these if defined.
-
-(defun edebug-safe-prin1-to-string (value)
-  (let ((print-escape-newlines t)
-	(print-length (or edebug-print-length print-length))
-	(print-level (or edebug-print-level print-level))
-	(print-circle (or edebug-print-circle print-circle))
-	(print-readably nil)) ;; lemacs uses this.
-    (edebug-prin1-to-string value)))
-
-(defun edebug-compute-previous-result (edebug-previous-value)
-  (setq edebug-previous-result
-	(if (and (numberp edebug-previous-value)
-		 (< edebug-previous-value 256)
-		 (>= edebug-previous-value 0))
-	    (format "Result: %s = %s" edebug-previous-value
-		    (single-key-description edebug-previous-value))
-	  (if edebug-unwrap-results
-	      (setq edebug-previous-value 
-		    (edebug-unwrap* edebug-previous-value)))
-	  (concat "Result: " 
-		  (edebug-safe-prin1-to-string edebug-previous-value)))))
-
-(defun edebug-previous-result ()
-  "Print the previous result."
-  (interactive)
-  (message "%s" edebug-previous-result))
-
-;;; Read, Eval and Print
-
-(defun edebug-eval-expression (edebug-expr)
-  "Evaluate an expression in the outside environment.  
-If interactive, prompt for the expression.
-Print result in minibuffer."
-  (interactive "xEval: ")
-  (princ
-   (edebug-outside-excursion
-    (setq values (cons (edebug-eval edebug-expr) values))
-    (edebug-safe-prin1-to-string (car values)))))
-
-(defun edebug-eval-last-sexp ()
-  "Evaluate sexp before point in the outside environment;
-print value in minibuffer."
-  (interactive)
-  (edebug-eval-expression (edebug-last-sexp)))
-
-(defun edebug-eval-print-last-sexp ()
-  "Evaluate sexp before point in the outside environment; 
-print value into current buffer."
-  (interactive)
-  (let* ((edebug-form (edebug-last-sexp))
-	 (edebug-result-string
-	  (edebug-outside-excursion 
-	   (edebug-safe-prin1-to-string (edebug-safe-eval edebug-form))))
-	 (standard-output (current-buffer)))
-    (princ "\n")
-    ;; princ the string to get rid of quotes.
-    (princ edebug-result-string)
-    (princ "\n")
-    ))
-
-;;; Edebug Minor Mode 
-
-;; Global GUD bindings for all emacs-lisp-mode buffers.
-(define-key emacs-lisp-mode-map "\C-x\C-a\C-s" 'edebug-step-mode)
-(define-key emacs-lisp-mode-map "\C-x\C-a\C-n" 'edebug-next-mode)
-(define-key emacs-lisp-mode-map "\C-x\C-a\C-c" 'edebug-go-mode)
-(define-key emacs-lisp-mode-map "\C-x\C-a\C-l" 'edebug-where)
-    
-
-(defvar edebug-mode-map nil)
-(if edebug-mode-map
-    nil
-  (progn
-    (setq edebug-mode-map (copy-keymap emacs-lisp-mode-map))
-    ;; control
-    (define-key edebug-mode-map " " 'edebug-step-mode)
-    (define-key edebug-mode-map "n" 'edebug-next-mode)
-    (define-key edebug-mode-map "g" 'edebug-go-mode)
-    (define-key edebug-mode-map "G" 'edebug-Go-nonstop-mode)
-    (define-key edebug-mode-map "t" 'edebug-trace-mode)
-    (define-key edebug-mode-map "T" 'edebug-Trace-fast-mode)
-    (define-key edebug-mode-map "c" 'edebug-continue-mode)
-    (define-key edebug-mode-map "C" 'edebug-Continue-fast-mode)
-
-    ;;(define-key edebug-mode-map "f" 'edebug-forward) not implemented
-    (define-key edebug-mode-map "f" 'edebug-forward-sexp)
-    (define-key edebug-mode-map "h" 'edebug-goto-here)
-
-    (define-key edebug-mode-map "I" 'edebug-instrument-callee)
-    (define-key edebug-mode-map "i" 'edebug-step-in)
-    (define-key edebug-mode-map "o" 'edebug-step-out)
-    
-    ;; quitting and stopping
-    (define-key edebug-mode-map "q" 'top-level)
-    (define-key edebug-mode-map "Q" 'edebug-top-level-nonstop)
-    (define-key edebug-mode-map "a" 'abort-recursive-edit)
-    (define-key edebug-mode-map "S" 'edebug-stop)
-
-    ;; breakpoints
-    (define-key edebug-mode-map "b" 'edebug-set-breakpoint)
-    (define-key edebug-mode-map "u" 'edebug-unset-breakpoint)
-    (define-key edebug-mode-map "B" 'edebug-next-breakpoint)
-    (define-key edebug-mode-map "x" 'edebug-set-conditional-breakpoint)
-    (define-key edebug-mode-map "X" 'edebug-set-global-break-condition)
-    
-    ;; evaluation
-    (define-key edebug-mode-map "r" 'edebug-previous-result)
-    (define-key edebug-mode-map "e" 'edebug-eval-expression)
-    (define-key edebug-mode-map "\C-x\C-e" 'edebug-eval-last-sexp)
-    (define-key edebug-mode-map "E" 'edebug-visit-eval-list)
-    
-    ;; views
-    (define-key edebug-mode-map "w" 'edebug-where)
-    (define-key edebug-mode-map "v" 'edebug-view-outside)  ;; maybe obsolete??
-    (define-key edebug-mode-map "p" 'edebug-bounce-point)
-    (define-key edebug-mode-map "P" 'edebug-view-outside) ;; same as v
-    (define-key edebug-mode-map "W" 'edebug-toggle-save-windows)
-
-    ;; misc
-    (define-key edebug-mode-map "?" 'edebug-help)
-    (define-key edebug-mode-map "d" 'edebug-backtrace)
-    
-    (define-key edebug-mode-map "-" 'negative-argument)
-
-    ;; statistics
-    (define-key edebug-mode-map "=" 'edebug-temp-display-freq-count)
-
-    ;; GUD bindings
-    (define-key edebug-mode-map "\C-c\C-s" 'edebug-step-mode)
-    (define-key edebug-mode-map "\C-c\C-n" 'edebug-next-mode)
-    (define-key edebug-mode-map "\C-c\C-c" 'edebug-go-mode)
-
-    (define-key edebug-mode-map "\C-x " 'edebug-set-breakpoint)
-    (define-key edebug-mode-map "\C-c\C-d" 'edebug-unset-breakpoint)
-    (define-key edebug-mode-map "\C-c\C-t" 
-      (function (lambda () (edebug-set-breakpoint t))))
-    (define-key edebug-mode-map "\C-c\C-l" 'edebug-where)
-    ))
-
-;; Autoloading these global bindings doesn't make sense because
-;; they cannot be used anyway unless Edebug is already loaded and active.
-
-(defvar global-edebug-prefix "\^XX"
-  "Prefix key for global edebug commands, available from any buffer.")
-
-(defvar global-edebug-map nil
-  "Global map of edebug commands, available from any buffer.")
-
-(if global-edebug-map
-    nil
-  (setq global-edebug-map (make-sparse-keymap))
-
-  (global-unset-key global-edebug-prefix)
-  (global-set-key global-edebug-prefix global-edebug-map)
-
-  (define-key global-edebug-map " " 'edebug-step-mode)
-  (define-key global-edebug-map "g" 'edebug-go-mode)
-  (define-key global-edebug-map "G" 'edebug-Go-nonstop-mode)
-  (define-key global-edebug-map "t" 'edebug-trace-mode)
-  (define-key global-edebug-map "T" 'edebug-Trace-fast-mode)
-  (define-key global-edebug-map "c" 'edebug-continue-mode)
-  (define-key global-edebug-map "C" 'edebug-Continue-fast-mode)
-
-  ;; breakpoints
-  (define-key global-edebug-map "b" 'edebug-set-breakpoint)
-  (define-key global-edebug-map "u" 'edebug-unset-breakpoint)
-  (define-key global-edebug-map "x" 'edebug-set-conditional-breakpoint)
-  (define-key global-edebug-map "X" 'edebug-set-global-break-condition)
-
-  ;; views
-  (define-key global-edebug-map "w" 'edebug-where)
-  (define-key global-edebug-map "W" 'edebug-toggle-save-windows)
-
-  ;; quitting
-  (define-key global-edebug-map "q" 'top-level)
-  (define-key global-edebug-map "Q" 'edebug-top-level-nonstop)
-  (define-key global-edebug-map "a" 'abort-recursive-edit)
-
-  ;; statistics
-  (define-key global-edebug-map "=" 'edebug-display-freq-count)
-  )
-
-(defun edebug-help ()
-  (interactive)
-  (describe-function 'edebug-mode))
-
-(defun edebug-mode ()
-  "Mode for Emacs Lisp buffers while in Edebug.
-
-In addition to all Emacs Lisp commands (except those that modify the
-buffer) there are local and global key bindings to several Edebug
-specific commands.  E.g. `edebug-step-mode' is bound to \\[edebug-step-mode] 
-in the Edebug buffer and \\<global-map>\\[edebug-step-mode] in any buffer.
-
-Also see bindings for the eval list buffer, *edebug*.
-
-The edebug buffer commands:
-\\{edebug-mode-map}
-
-Global commands prefixed by `global-edebug-prefix':
-\\{global-edebug-map}
-
-Options:
-edebug-setup-hook
-edebug-all-defs
-edebug-all-forms
-edebug-save-windows
-edebug-save-displayed-buffer-points
-edebug-initial-mode
-edebug-trace
-edebug-test-coverage
-edebug-continue-kbd-macro
-edebug-print-length
-edebug-print-level
-edebug-print-circle
-edebug-on-error
-edebug-on-quit
-edebug-on-signal
-edebug-unwrap-results
-edebug-global-break-condition
-"
-  (use-local-map edebug-mode-map))
-
-;;; edebug eval list mode
-
-;; A list of expressions and their evaluations is displayed in *edebug*.
-
-(defun edebug-eval-result-list ()
-  "Return a list of evaluations of edebug-eval-list"
-  ;; Assumes in outside environment.
-  ;; Don't do any edebug things now.
-  (let ((edebug-execution-mode 'Go-nonstop)
-	(edebug-trace nil)) 
-    (mapcar 'edebug-safe-eval edebug-eval-list)))
-
-(defun edebug-eval-display-list (edebug-eval-result-list)
-  ;; Assumes edebug-eval-buffer exists.
-  (let ((edebug-eval-list-temp edebug-eval-list)
-	(standard-output edebug-eval-buffer)
-	(edebug-comment-line
-	 (format ";%s\n" (make-string (- (window-width) 2) ?-))))
-    (set-buffer edebug-eval-buffer)
-    (erase-buffer)
-    (while edebug-eval-list-temp
-      (prin1 (car edebug-eval-list-temp)) (terpri)
-      (prin1 (car edebug-eval-result-list)) (terpri)
-      (princ edebug-comment-line)
-      (setq edebug-eval-list-temp (cdr edebug-eval-list-temp))
-      (setq edebug-eval-result-list (cdr edebug-eval-result-list)))
-    (edebug-pop-to-buffer edebug-eval-buffer)
-    ))
-
-(defun edebug-create-eval-buffer ()
-  (if (not (and edebug-eval-buffer (buffer-name edebug-eval-buffer)))
-      (progn
-	(set-buffer (setq edebug-eval-buffer (get-buffer-create "*edebug*")))
-	(edebug-eval-mode))))
-
-;; Should generalize this to be callable outside of edebug
-;; with calls in user functions, e.g. (edebug-eval-display)
-
-(defun edebug-eval-display (edebug-eval-result-list)
-  "Display expressions and evaluations in EVAL-LIST.
-It modifies the context by popping up the eval display."
-  (if edebug-eval-result-list
-      (progn
-	(edebug-create-eval-buffer)
-	(edebug-eval-display-list edebug-eval-result-list)
-	)))
-
-(defun edebug-eval-redisplay ()
-  "Redisplay eval list in outside environment.
-May only be called from within edebug-recursive-edit."
-  (edebug-create-eval-buffer)
-  (edebug-outside-excursion
-   (edebug-eval-display-list (edebug-eval-result-list))
-   ))
-
-(defun edebug-visit-eval-list ()
-  (interactive)
-  (edebug-eval-redisplay)
-  (edebug-pop-to-buffer edebug-eval-buffer))
-
-
-(defun edebug-update-eval-list ()
-  "Replace the evaluation list with the sexps now in the eval buffer."
-  (interactive)
-  (let ((starting-point (point))
-	new-list)
-    (goto-char (point-min))
-    ;; get the first expression
-    (edebug-skip-whitespace)
-    (if (not (eobp))
-	(progn
-	  (forward-sexp 1)
-	  (setq new-list (cons (edebug-last-sexp) new-list))))
-    
-    (while (re-search-forward "^;" nil t)
-      (forward-line 1)
-      (skip-chars-forward " \t\n\r")
-      (if (and (/= ?\; (following-char))
-	       (not (eobp)))
-	  (progn
-	    (forward-sexp 1)
-	    (setq new-list (cons (edebug-last-sexp) new-list)))))
-    
-    (setq edebug-eval-list (nreverse new-list))
-    (edebug-eval-redisplay)
-    (goto-char starting-point)))
-
-
-(defun edebug-delete-eval-item ()
-  "Delete the item under point and redisplay."
-  ;; could add arg to do repeatedly
-  (interactive)
-  (if (re-search-backward "^;" nil 'nofail)
-      (forward-line 1))
-  (delete-region
-   (point) (progn (re-search-forward "^;" nil 'nofail)
-		  (beginning-of-line)
-		  (point)))
-  (edebug-update-eval-list))
-
-
-
-(defvar edebug-eval-mode-map nil
-  "Keymap for edebug-eval-mode.  Superset of lisp-interaction-mode.")
-
-(if edebug-eval-mode-map
-    nil
-  (setq edebug-eval-mode-map (copy-keymap lisp-interaction-mode-map))
-  
-  (define-key edebug-eval-mode-map "\C-c\C-w" 'edebug-where)
-  (define-key edebug-eval-mode-map "\C-c\C-d" 'edebug-delete-eval-item)
-  (define-key edebug-eval-mode-map "\C-c\C-u" 'edebug-update-eval-list)
-  (define-key edebug-eval-mode-map "\C-x\C-e" 'edebug-eval-last-sexp)
-  (define-key edebug-eval-mode-map "\C-j" 'edebug-eval-print-last-sexp)
-  )
-
-
-(defun edebug-eval-mode ()
-  "Mode for evaluation list buffer while in Edebug.
-
-In addition to all Interactive Emacs Lisp commands there are local and
-global key bindings to several Edebug specific commands.  E.g.
-`edebug-step-mode' is bound to \\[edebug-step-mode] in the Edebug
-buffer and \\<global-map>\\[edebug-step-mode] in any buffer.
-
-Eval list buffer commands:
-\\{edebug-eval-mode-map}
-
-Global commands prefixed by global-edebug-prefix:
-\\{global-edebug-map}
-"
-  (lisp-interaction-mode)
-  (setq major-mode 'edebug-eval-mode)
-  (setq mode-name "Edebug-Eval")
-  (use-local-map edebug-eval-mode-map))
-
-;;; Interface with standard debugger.
-
-;; (setq debugger 'edebug) ; to use the edebug debugger
-;; (setq debugger 'debug)  ; use the standard debugger
-
-;; Note that debug and its utilities must be byte-compiled to work,
-;; since they depend on the backtrace looking a certain way.  But
-;; edebug is not dependent on this, yet.
-
-(defun edebug (&optional edebug-arg-mode &rest debugger-args)
-  "Replacement for debug.  
-If we are running an edebugged function,
-show where we last were.  Otherwise call debug normally."
-;;  (message "entered: %s  depth: %s  edebug-recursion-depth: %s"
-;;	   edebug-entered (recursion-depth) edebug-recursion-depth) (sit-for 1)
-  (if (and edebug-entered  ; anything active?
-	   (eq (recursion-depth) edebug-recursion-depth))
-      (let (;; Where were we before the error occurred?
-	    (edebug-offset-index (car edebug-offset-indices))
-	    ;; Bind variables required by edebug-display
-	    (edebug-value (car debugger-args))
-	    edebug-breakpoints
-	    edebug-break-data
-	    edebug-break-condition
-	    edebug-global-break
-	    (edebug-break (null edebug-arg-mode)) ;; if called explicitly
-	    )
-	(edebug-display)
-	(if (eq edebug-arg-mode 'error) 
-	    nil
-	  edebug-value))
-
-    ;; Otherwise call debug normally.
-    ;; Still need to remove extraneous edebug calls from stack.
-    (apply 'debug edebug-arg-mode debugger-args)
-    ))
-
-
-(defun edebug-backtrace ()
-  "Display a non-working backtrace.  Better than nothing..."
-  (interactive)
-  (if (or (not edebug-backtrace-buffer)
-	  (null (buffer-name edebug-backtrace-buffer)))
-      (setq edebug-backtrace-buffer
-	    (generate-new-buffer "*Backtrace*"))
-    ;; else, could just display edebug-backtrace-buffer
-    )
-  (with-output-to-temp-buffer (buffer-name edebug-backtrace-buffer)
-    (setq edebug-backtrace-buffer standard-output)
-    (let ((print-escape-newlines t)
-	  (print-length 50)
-	  last-ok-point)
-      (backtrace)
-
-      ;; Clean up the backtrace.  
-      ;; Not quite right for current edebug scheme.
-      (set-buffer edebug-backtrace-buffer)
-      (setq truncate-lines t)
-      (goto-char (point-min))
-      (setq last-ok-point (point))
-      (if t (progn
-
-      ;; Delete interspersed edebug internals.
-      (while (re-search-forward "^  \(?edebug" nil t)
-	(beginning-of-line)
-	(cond 
-	 ((looking-at "^  \(edebug-after")
-	  ;; Previous lines may contain code, so just delete this line
-	  (setq last-ok-point (point))
-	  (forward-line 1)
-	  (delete-region last-ok-point (point)))
-
-	 ((looking-at "^  edebug")
-	  (forward-line 1)
-	  (delete-region last-ok-point (point))
-	  )))
-      )))))
-
-
-;;; Trace display
-
-(defun edebug-trace-display (buf-name fmt &rest args)
-  "In buffer BUF-NAME, display FMT and ARGS at the end and make it visible.
-The buffer is created if it does not exist.
-You must include newlines in FMT to break lines, but one newline is appended."
-;; e.g.
-;;	 (edebug-trace-display "*trace-point*"
-;;	  "saving: point = %s  window-start = %s"
-;;	  (point) (window-start))
-  (let* ((oldbuf (current-buffer))
-	 (selected-window (selected-window))
-	 (buffer (get-buffer-create buf-name))
-	 buf-window)
-;;    (message "before pop-to-buffer") (sit-for 1)
-    (edebug-pop-to-buffer buffer)
-    (setq truncate-lines t)
-    (setq buf-window (selected-window))
-    (goto-char (point-max))
-    (insert (apply 'edebug-format fmt args) "\n")
-    ;; Make it visible.
-    (vertical-motion (- 1 (window-height)))
-    (set-window-start buf-window (point))
-    (goto-char (point-max))
-;;    (set-window-point buf-window (point))
-;;    (edebug-sit-for 0)
-    (bury-buffer buffer)
-    (select-window selected-window)
-    (set-buffer oldbuf))
-  buf-name)
-
-
-(defun edebug-trace (fmt &rest args)
-  "Convenience call to edebug-trace-display using edebug-trace-buffer"
-  (apply 'edebug-trace-display edebug-trace-buffer fmt args))
-
-
-;;; Frequency count and coverage
-
-(defun edebug-display-freq-count ()
-  "Display the frequency count data for each line of the current
-definition.  The frequency counts are inserted as comment lines after
-each line, and you can undo all insertions with one `undo' command.
-
-The counts are inserted starting under the `(' before an expression
-or the `)' after an expression, or on the last char of a symbol.
-The counts are only displayed when they differ from previous counts on
-the same line.
-
-If coverage is being tested, whenever all known results of an expression
-are `eq', the char `=' will be appended after the count
-for that expression.  Note that this is always the case for an
-expression only evaluated once.
-
-To clear the frequency count and coverage data for a definition,
-reinstrument it."
-  (interactive)
-  (let* ((function (edebug-form-data-symbol))
-	 (counts (get function 'edebug-freq-count))
-	 (coverages (get function 'edebug-coverage))
-	 (data (get function 'edebug))
-	 (def-mark (car data))	; mark at def start
-	 (edebug-points (nth 2 data))
-	 (i (1- (length edebug-points)))
-	 (last-index)
-	 (first-index)
-	 (start-of-line)
-	 (start-of-count-line)
-	 (last-count)
-	 )
-    (save-excursion
-      ;; Traverse in reverse order so offsets are correct.
-      (while (<= 0 i)
-	;; Start at last expression in line.
-	(goto-char (+ def-mark (aref edebug-points i)))
-	(beginning-of-line)
-	(setq start-of-line (- (point) def-mark)
-	      last-index i)
-
-	;; Find all indexes on same line.
-	(while (and (<= 0 (setq i (1- i))) 
-		    (<= start-of-line (aref edebug-points i))))
-	;; Insert all the indices for this line.
-	(forward-line 1)
-	(setq start-of-count-line (point)
-	      first-index i   ; really last index for line above this one.
-	      last-count -1)  ; cause first count to always appear.
-	(insert ";#")
-	;; i == first-index still
-	(while (<= (setq i (1+ i)) last-index)
-	  (let ((count (aref counts i))
-		(coverage (aref coverages i))
-		(col (save-excursion
-		       (goto-char (+ (aref edebug-points i) def-mark))
-		       (- (current-column)
-			  (if (= ?\( (following-char)) 0 1)))))
-	    (insert (make-string 
-		     (max 0 (- col (- (point) start-of-count-line))) ?\ )
-		    (if (and (< 0 count)
-			     (not (memq coverage 
-					'(unknown ok-coverage))))
-			"=" "")
-		    (if (= count last-count) "" (int-to-string count))
-		    " ")
-	    (setq last-count count)))
-	(insert "\n")
-	(setq i first-index)))))
-
-(defun edebug-temp-display-freq-count ()
-  "Temporarily display the frequency count data for the current definition.
-It is removed when you hit any char."
-  ;; This seems not to work with Emacs 18.59. It undoes too far.
-  (interactive)
-  (let ((buffer-read-only nil))
-    (undo-boundary)
-    (edebug-display-freq-count)
-    (setq unread-command-char (read-char))
-    (undo)))
-
-
-;;; Menus
-
-(defun edebug-toggle (variable)
-  (set variable (not (eval variable)))
-  (message "%s: %s" variable (eval variable)))
-
-;; We have to require easymenu (even for Emacs 18) just so
-;; the easy-menu-define macro call is compiled correctly.
-(require 'easymenu)
-
-(defconst edebug-mode-menus
-  '("Edebug"
-     "----"
-     ["Stop" edebug-stop t]
-     ["Step" edebug-step-mode t]
-     ["Next" edebug-next-mode t]
-     ["Trace" edebug-trace-mode t]
-     ["Trace Fast" edebug-Trace-fast-mode t]
-     ["Continue" edebug-continue-mode t]
-     ["Continue Fast" edebug-Continue-fast-mode t]
-     ["Go" edebug-go-mode t]
-     ["Go Nonstop" edebug-Go-nonstop-mode t]
-     "----"
-     ["Help" edebug-help t]
-     ["Abort" abort-recursive-edit t]
-     ["Quit to Top Level"  top-level t]
-     ["Quit Nonstop" edebug-top-level-nonstop t]
-     "----"
-    ("Jumps"
-     ["Forward Sexp" edebug-forward-sexp t]
-     ["Step In" edebug-step-in t]
-     ["Step Out" edebug-step-out t]
-     ["Goto Here" edebug-goto-here t])
-
-    ("Breaks"
-     ["Set Breakpoint" edebug-set-breakpoint t]
-     ["Unset Breakpoint" edebug-unset-breakpoint t]
-     ["Set Conditional Breakpoint" edebug-set-conditional-breakpoint t]
-     ["Set Global Break Condition" edebug-set-global-break-condition t]
-     ["Show Next Breakpoint" edebug-next-breakpoint t])
-
-    ("Views"
-     ["Where am I?" edebug-where t]
-     ["Bounce to Current Point" edebug-bounce-point t]
-     ["View Outside Windows" edebug-view-outside t]
-     ["Previous Result" edebug-previous-result t]
-     ["Show Backtrace" edebug-backtrace t]
-     ["Display Freq Count" edebug-display-freq-count t])
-
-    ("Eval"
-     ["Expression" edebug-eval-expression t]
-     ["Last Sexp" edebug-eval-last-sexp t]
-     ["Visit Eval List" edebug-visit-eval-list t])
-
-    ("Options"
-     ["Edebug All Defs" edebug-all-defs t]
-     ["Edebug All Forms" edebug-all-forms t]
-     "----"
-     ["Toggle Tracing" (edebug-toggle 'edebug-trace) t]
-     ["Toggle Coverage Testing" (edebug-toggle 'edebug-test-coverage) t]
-     ["Toggle Window Saving" edebug-toggle-save-windows t]
-     ["Toggle Point Saving" 
-      (edebug-toggle 'edebug-save-displayed-buffer-points) t]
-     ))
-  "Lemacs style menus for Edebug.")
-
-
-;;; Emacs version specific code
-
-;;; The default for all above is Emacs 18, because it is easier to compile
-;;; Emacs 18 code in Emacs 19 than vice versa.  This default will
-;;; change once most people are using Emacs 19 or derivatives.
-
-;; Epoch specific code is in a separate file: edebug-epoch.el.
-
-;; The byte-compiler will complain about changes in number of arguments
-;; to functions like mark and read-from-minibuffer.  These warnings
-;; may be ignored because the right call should always be made.
-
-(defun edebug-emacs-19-specific ()
-
-  (defalias 'edebug-window-live-p 'window-live-p)
-
-  ;; Mark takes an argument in Emacs 19.
-  (defun edebug-mark ()
-    (mark t));; Does this work for lemacs too?
-
-  (defun edebug-set-conditional-breakpoint (arg condition)
-    "Set a conditional breakpoint at nearest sexp.
-The condition is evaluated in the outside context.
-With prefix argument, make it a temporary breakpoint."
-    ;; (interactive "P\nxCondition: ")
-    (interactive 
-     (list
-      current-prefix-arg
-      ;; Read condition as follows; getting previous condition is cumbersome:
-      (let ((edebug-stop-point (edebug-find-stop-point)))
-	(if edebug-stop-point
-	    (let* ((edebug-def-name (car edebug-stop-point))
-		   (index (cdr edebug-stop-point))
-		   (edebug-data (get edebug-def-name 'edebug))
-		   (edebug-breakpoints (car (cdr edebug-data)))
-		   (edebug-break-data (assq index edebug-breakpoints))
-		   (edebug-break-condition (car (cdr edebug-break-data)))
-		   (edebug-expression-history
-		    ;; Prepend the current condition, if any.
-		    (if edebug-break-condition
-			(cons edebug-break-condition read-expression-history)
-		      read-expression-history)))
-	      (prog1
-		  (read-from-minibuffer 
-		   "Condition: " nil read-expression-map t
-		   'edebug-expression-history)
-		(setq read-expression-history edebug-expression-history)
-		))))))
-    (edebug-modify-breakpoint t condition arg))
-
-  (defun edebug-eval-expression (edebug-expr)
-    "Evaluate an expression in the outside environment.  
-If interactive, prompt for the expression.
-Print result in minibuffer."
-    (interactive (list (read-from-minibuffer 
-			"Eval: " nil read-expression-map t
-			'read-expression-history)))
-    (princ
-     (edebug-outside-excursion
-      (setq values (cons (edebug-eval edebug-expr) values))
-      (edebug-safe-prin1-to-string (car values)))))
-
-  (easy-menu-define edebug-menu edebug-mode-map "Edebug menus" edebug-mode-menus)
-  (if window-system
-      (x-popup-menu nil (lookup-key edebug-mode-map [menu-bar Edebug])))
-  )
-
-
-(defun edebug-lemacs-specific ()
-
-  ;; We need to bind zmacs-regions to nil around all calls to `mark' and
-  ;; `mark-marker' but don't bind it to nil before entering a recursive edit,
-  ;; that is, don't interfere with the binding the user might see while 
-  ;; executing a command.
-
-  (defvar zmacs-regions)
-  
-  (defun edebug-mark ()
-    (let ((zmacs-regions nil))
-      (mark)))
-
-  (defun edebug-mark-marker ()
-    (let ((zmacs-regions nil));; for lemacs
-      (mark-marker)))
-
-
-  (defun edebug-mode-menu (event)
-    (interactive "@event")
-    (popup-menu edebug-mode-menus))
-
-  (define-key edebug-mode-map 'button3 'edebug-mode-menu)
-  )
-
-(defun edebug-emacs-version-specific ()
-  (cond 
-   ((string-match "Lucid" emacs-version);; Lucid Emacs
-    (edebug-lemacs-specific))
-
-   ((and (boundp 'epoch::version) epoch::version)
-    (require 'edebug-epoch))
-
-   ((not (string-match "^18" emacs-version))
-    (edebug-emacs-19-specific))))
-
-(edebug-emacs-version-specific)
-
-
-;;; Byte-compiler
-
-;; Extension for bytecomp to resolve undefined function references.
-;; Requires new byte compiler.
-
-;; Reenable byte compiler warnings about unread-command-char and -event.
-;; Disabled before edebug-recursive-edit.
-(eval-when-compile
-  (if edebug-unread-command-char-warning
-      (put 'unread-command-char 'byte-obsolete-variable 
-	   edebug-unread-command-char-warning))
-  (if edebug-unread-command-event-warning
-      (put 'unread-command-event 'byte-obsolete-variable 
-	   edebug-unread-command-event-warning)))
-
-(eval-when-compile
-  ;; The body of eval-when-compile seems to get evaluated with eval-defun.
-  ;; We only want to evaluate when actually byte compiling.
-  ;; But it is OK to evaluate as long as byte-compiler has been loaded.
-  (if (featurep 'byte-compile) (progn
-
-  (defun byte-compile-resolve-functions (funcs)
-    "Say it is OK for the named functions to be unresolved."
-    (mapcar 
-     (function 
-      (lambda (func)
-	(setq byte-compile-unresolved-functions
-	      (delq (assq func byte-compile-unresolved-functions)
-		    byte-compile-unresolved-functions))))
-     funcs)
-    nil)
-  
-  '(defun byte-compile-resolve-free-references (vars)
-     "Say it is OK for the named variables to be referenced."
-     (mapcar 
-      (function 
-       (lambda (var)
-	 (setq byte-compile-free-references
-	       (delq var byte-compile-free-references))))
-      vars)
-     nil)
-
-  '(defun byte-compile-resolve-free-assignments (vars)
-     "Say it is OK for the named variables to be assigned."
-     (mapcar 
-      (function 
-       (lambda (var)
-	 (setq byte-compile-free-assignments
-	       (delq var byte-compile-free-assignments))))
-      vars)
-     nil)
-
-  (byte-compile-resolve-functions 
-   '(reporter-submit-bug-report 
-     edebug-gensym ;; also in cl.el
-     ;; Interfaces to standard functions.
-     edebug-original-eval-defun 
-     edebug-original-read
-     edebug-get-buffer-window
-     edebug-mark
-     edebug-mark-marker
-     edebug-input-pending-p 
-     edebug-sit-for
-     edebug-prin1-to-string 
-     edebug-format
-     ;; lemacs
-     zmacs-deactivate-region
-     popup-menu
-     ;; CL
-     cl-macroexpand-all
-     ;; And believe it or not, the byte compiler doesn't know about:
-     byte-compile-resolve-functions
-     ))
-
-  '(byte-compile-resolve-free-references
-    '(read-expression-history
-      read-expression-map))
-
-  '(byte-compile-resolve-free-assignments
-    '(read-expression-history))
-
-  )))
-
-
-;;; Autoloading of Edebug accessories
-
-(if (featurep 'cl)
-    (add-hook 'edebug-setup-hook
-	      (function (lambda () (require 'cl-specs))))
-  ;; The following causes cl-specs to be loaded if you load cl.el.
-  (add-hook 'cl-load-hook
-	    (function (lambda () (require 'cl-specs)))))
-
-;;; edebug-cl-read and cl-read are available from liberte@cs.uiuc.edu 
-(if (featurep 'cl-read)
-    (add-hook 'edebug-setup-hook
-	      (function (lambda () (require 'edebug-cl-read))))
-  ;; The following causes edebug-cl-read to be loaded when you load cl-read.el.
-  (add-hook 'cl-read-load-hooks
-	    (function (lambda () (require 'edebug-cl-read)))))
-
-
-;;; Finalize Loading
-
-;;; Finally, hook edebug into the rest of Emacs.
-;;; There are probably some other things that could go here.
-
-;; Install edebug read and eval functions.
-(edebug-install-read-eval-functions)
-
-(provide 'edebug)
-
-;;; edebug.el ends here
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
deleted file mode 100644
index ff84819c748..00000000000
--- a/lisp/emacs-lisp/eldoc.el
+++ /dev/null
@@ -1,458 +0,0 @@
-;;; eldoc.el --- show function arglist or variable docstring in echo area
-
-;; Copyright (C) 1995 Noah S. Friedman
-
-;; Author: Noah Friedman <friedman@prep.ai.mit.edu>
-;; Maintainer: friedman@prep.ai.mit.edu
-;; Keywords: extensions
-;; Status: Works in Emacs 19 and XEmacs.
-;; Created: 1995-10-06
-
-;; LCD Archive Entry:
-;; eldoc|Noah Friedman|friedman@prep.ai.mit.edu|
-;; show function arglist or variable docstring in echo area|
-;; $Date: 1996/07/14 16:46:25 $|$Revision: 1.6 $|~/misc/eldoc.el.gz|
-
-;; $Id: eldoc.el,v 1.6 1996/07/14 16:46:25 friedman Exp friedman $
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This program was inspired by the behavior of the Lisp Machine "mouse
-;; documentation window"; as you type a function's symbol name as part of a
-;; sexp, it will print the argument list for that function.  However, this
-;; program's behavior is different in a couple of significant ways.  For
-;; one, you need not actually type the function name; you need only move
-;; point around in a sexp that calls it.  However, if point is over a
-;; documented variable, it will print the one-line documentation for that
-;; variable instead, to remind you of that variable's purpose.
-
-;; One useful way to enable this minor mode is to put the following in your
-;; .emacs:
-;;
-;;      (autoload 'turn-on-eldoc-mode "eldoc" nil t)
-;;      (add-hook 'emacs-lisp-mode-hook 'turn-on-eldoc-mode)
-;;      (add-hook 'lisp-interaction-mode-hook 'turn-on-eldoc-mode)
-
-;;; Code:
-
-;;;###autoload
-(defvar eldoc-mode nil
-  "*If non-nil, show the defined parameters for the elisp function near point.
-
-For the emacs lisp function at the beginning of the sexp which point is
-within, show the defined parameters for the function in the echo area.
-This information is extracted directly from the function or macro if it is
-in pure lisp.
-
-If the emacs function is a subr, the parameters are obtained from the
-documentation string if possible.
-
-If point is over a documented variable, print that variable's docstring
-instead; see function `eldoc-print-var-docstring'.
-
-This variable is buffer-local.")
-(make-variable-buffer-local 'eldoc-mode)
-
-(defvar eldoc-idle-delay 0.50
-  "*Number of seconds of idle time to wait before printing.
-If user input arrives before this interval of time has elapsed after the
-last input, no documentation will be printed.
-
-If this variable is set to 0, no idle time is required.")
-
-(defvar eldoc-argument-case 'upcase
-  "Case to display argument names of functions, as a symbol.
-This has two preferred values: `upcase' or `downcase'.
-Actually, any name of a function which takes a string as an argument and
-returns another string is acceptable.")
-
-(defvar eldoc-mode-message-commands nil
-  "*Obarray of command names where it is appropriate to print in the echo area.
-
-This is not done for all commands since some print their own
-messages in the echo area, and these functions would instantly overwrite
-them.  But self-insert-command as well as most motion commands are good
-candidates.
-
-It is probably best to manipulate this data structure with the commands
-`eldoc-add-command' and `eldoc-remove-command'.")
-
-(cond ((null eldoc-mode-message-commands)
-       ;; If you increase the number of buckets, keep it a prime number.
-       (setq eldoc-mode-message-commands (make-vector 31 0))
-       (let ((list '("self-insert-command"
-                     "next-"         "previous-"
-                     "forward-"      "backward-"
-                     "beginning-of-" "end-of-"
-                     "goto-"
-                     "recenter"
-                     "scroll-"))
-             (syms nil))
-         (while list
-           (setq syms (all-completions (car list) obarray 'fboundp))
-           (setq list (cdr list))
-           (while syms
-             (set (intern (car syms) eldoc-mode-message-commands) t)
-             (setq syms (cdr syms)))))))
-
-;; Bookkeeping; the car contains the last symbol read from the buffer.
-;; The cdr contains the string last displayed in the echo area, so it can
-;; be printed again if necessary without reconsing.
-(defvar eldoc-last-data '(nil . nil))
-
-(defvar eldoc-minor-mode-string " ElDoc"
-  "*String to display in mode line when Eldoc Mode is enabled.")
-
-;; Put this minor mode on the global minor-mode-alist.
-(or (assq 'eldoc-mode (default-value 'minor-mode-alist))
-    (setq-default minor-mode-alist
-                  (append (default-value 'minor-mode-alist)
-                          '((eldoc-mode eldoc-minor-mode-string)))))
-
-;; In emacs 19.29 and later, and XEmacs 19.13 and later, all messages are
-;; recorded in a log.  Do not put eldoc messages in that log since
-;; they are Legion.
-(defmacro eldoc-message (&rest args)
-  (if (fboundp 'display-message)
-      ;; XEmacs 19.13 way of preventing log messages.
-      (list 'display-message '(quote no-log) (apply 'list 'format args))
-    (list 'let (list (list 'message-log-max 'nil))
-          (apply 'list 'message args))))
-
-
-;;;###autoload
-(defun eldoc-mode (&optional prefix)
-  "*If non-nil, then enable eldoc-mode (see variable docstring)."
-  (interactive "P")
-
-  ;; Make sure it's on the post-command-idle-hook if defined, otherwise put
-  ;; it on post-command-hook.  The former first appeared in Emacs 19.30.
-  (add-hook (if (boundp 'post-command-idle-hook)
-                'post-command-idle-hook
-              'post-command-hook)
-            'eldoc-mode-print-current-symbol-info)
-
-  (setq eldoc-mode (if prefix
-                       (>= (prefix-numeric-value prefix) 0)
-                     (not eldoc-mode)))
-
-  (and (interactive-p)
-       (if eldoc-mode
-           (message "eldoc-mode is enabled")
-         (message "eldoc-mode is disabled")))
-  eldoc-mode)
-
-;;;###autoload
-(defun turn-on-eldoc-mode ()
-  "Unequivocally turn on eldoc-mode (see variable documentation)."
-  (interactive)
-  (eldoc-mode 1))
-
-(defun eldoc-add-command (cmd)
-  "Add COMMAND to the list of commands which causes function arg display.
-If called interactively, completion matches any bound function.
-
-When point is in a sexp, the function args are not reprinted in the echo
-area after every possible interactive command because some of them print
-their own messages in the echo area; the eldoc functions would instantly
-overwrite them unless it is more restrained."
-  (interactive "aAdd function to eldoc message commands list: ")
-  (and (fboundp cmd)
-       (set (intern (symbol-name cmd) eldoc-mode-message-commands) t)))
-
-(defun eldoc-remove-command (cmd)
-  "Remove COMMAND from the list of commands which causes function arg display.
-If called interactively, completion matches only those functions currently
-in the list.
-
-When point is in a sexp, the function args are not reprinted in the echo
-area after every possible interactive command because some of them print
-their own messages in the echo area; the eldoc functions would instantly
-overwrite them unless it is more restrained."
-  (interactive (list (completing-read
-                      "Remove function from eldoc message commands list: "
-                      eldoc-mode-message-commands 'boundp t)))
-  (and (symbolp cmd)
-       (setq cmd (symbol-name cmd)))
-  (if (fboundp 'unintern)
-      (unintern cmd eldoc-mode-message-commands)
-    (let ((s (intern-soft cmd eldoc-mode-message-commands)))
-      (and s
-           (makunbound s)))))
-
-(defun eldoc-mode-print-current-symbol-info ()
-  (and eldoc-mode
-       (not executing-macro)
-       ;; Having this mode operate in the minibuffer makes it impossible to
-       ;; see what you're doing.
-       (not (eq (selected-window) (minibuffer-window)))
-       (sit-for eldoc-idle-delay)
-       (symbolp this-command)
-       (intern-soft (symbol-name this-command) eldoc-mode-message-commands)
-       (let ((current-symbol (eldoc-current-symbol))
-             (current-fnsym  (eldoc-fnsym-in-current-sexp)))
-         (cond ((eq current-symbol current-fnsym)
-                (eldoc-print-fnsym-args current-fnsym))
-               (t
-                (or (eldoc-print-var-docstring current-symbol)
-                    (eldoc-print-fnsym-args current-fnsym)))))))
-
-
-(defun eldoc-print-var-docstring (&optional sym)
-  "Print the brief (one-line) documentation string for the variable at point.
-If called with no argument, print the first line of the variable
-documentation string for the symbol at point in the echo area.
-If called with a symbol, print the line for that symbol.
-
-If the entire line cannot fit in the echo area, the variable name may be
-truncated or eliminated entirely from the output to make room.
-Any leading `*' in the docstring (which indicates the variable is a user
-option) is not printed."
-  (interactive)
-  (let* ((s (or sym (eldoc-current-symbol)))
-         (name (symbol-name s))
-         (doc (and s (documentation-property s 'variable-documentation t))))
-    (and doc
-         (save-match-data
-           (and (string-match "\n" doc)
-                (setq doc (substring doc 0 (match-beginning 0))))
-           (and (string-match "^\\*" doc)
-                (setq doc (substring doc 1)))
-           (let* ((doclen (+ (length name) (length ": ") (length doc)))
-                  ;; Subtract 1 from window width since emacs seems not to
-                  ;; write any chars to the last column, at least for some
-                  ;; terminal types.
-                  (strip (- doclen (1- (window-width (minibuffer-window))))))
-             (cond ((> strip 0)
-                    (let* ((len (length name)))
-                      (cond ((>= strip len)
-                             (eldoc-message "%s" doc))
-                            (t
-                             (setq name (substring name 0 (- len strip)))
-                             (eldoc-message "%s: %s" name doc)))))
-                   (t
-                    (eldoc-message "%s: %s" s doc))))
-           t))))
-
-
-;;;###autoload
-(defun eldoc-print-fnsym-args (&optional symbol)
-  "*Show the defined parameters for the function near point.
-For the function at the beginning of the sexp which point is within, show
-the defined parameters for the function in the echo area.
-This information is extracted directly from the function or macro if it is
-in pure lisp.
-If the emacs function is a subr, the parameters are obtained from the
-documentation string if possible."
-  (interactive)
-  (let ((sym (or symbol (eldoc-fnsym-in-current-sexp)))
-        (printit t)
-        (args nil))
-    (cond ((not (and (symbolp sym)
-                     (fboundp sym))))
-          ((eq sym (car eldoc-last-data))
-           (setq printit nil)
-           (setq args (cdr eldoc-last-data)))
-          ((subrp (eldoc-symbol-function sym))
-           (setq args (eldoc-function-argstring-from-docstring sym))
-           (setcdr eldoc-last-data args))
-          (t
-           (setq args (eldoc-function-argstring sym))
-           (setcdr eldoc-last-data args)))
-    (and args
-         printit
-         (eldoc-message "%s: %s" sym args))))
-
-(defun eldoc-fnsym-in-current-sexp ()
-  (let* ((p (point))
-         (sym (progn
-                (while (and (eldoc-forward-sexp-safe -1)
-                            (> (point) (point-min))))
-                (cond ((or (= (point) (point-min))
-                           (memq (or (char-after (point)) 0)
-                                 '(?\( ?\"))
-                           ;; If we hit a quotation mark before a paren, we
-                           ;; are inside a specific string, not a list of
-                           ;; symbols.
-                           (eq (or (char-after (1- (point))) 0) ?\"))
-                       nil)
-                      (t (condition-case nil
-                             (read (current-buffer))
-                           (error nil)))))))
-    (goto-char p)
-    (and (symbolp sym)
-         sym)))
-
-(defun eldoc-function-argstring (fn)
-  (let* ((prelim-def (eldoc-symbol-function fn))
-         (def (if (eq (car-safe prelim-def) 'macro)
-                  (cdr prelim-def)
-                prelim-def))
-         (arglist (cond ((null def) nil)
-                        ((byte-code-function-p def)
-                         (if (fboundp 'compiled-function-arglist)
-                             (funcall 'compiled-function-arglist def)
-                           (aref def 0)))
-                        ((eq (car-safe def) 'lambda)
-                         (nth 1 def))
-                        (t t))))
-    (eldoc-function-argstring-format arglist)))
-
-(defun eldoc-function-argstring-from-docstring (fn)
-  (let ((docstring (documentation fn 'raw))
-        (doc nil)
-        (doclist nil)
-        (end nil))
-    (save-match-data
-      ;; TODO: Move these into a separate table that is iterated over until
-      ;; a match is found.
-      (cond
-       ;; Try first searching for args starting with symbol name.
-       ;; This is to avoid matching parenthetical remarks in e.g. sit-for.
-       ((string-match (format "^(%s[^\n)]*)$" fn) docstring)
-        ;; end does not include trailing ")" sequence.
-        (setq end (- (match-end 0) 1))
-        (if (string-match " +" docstring (match-beginning 0))
-            (setq doc (substring docstring (match-end 0) end))
-          (setq doc "")))
-
-       ;; Try again not requiring this symbol name in the docstring.
-       ;; This will be the case when looking up aliases.
-       ((string-match (format "^([^\n)]+)$" fn) docstring)
-        ;; end does not include trailing ")" sequence.
-        (setq end (- (match-end 0) 1))
-        (if (string-match " +" docstring (match-beginning 0))
-            (setq doc (substring docstring (match-end 0) end))
-          (setq doc "")))
-
-       ;; Emacs subr docstring style:
-       ;;   (fn arg1 arg2 ...): description...
-       ((string-match "^([^\n)]+):" docstring)
-        ;; end does not include trailing "):" sequence.
-        (setq end (- (match-end 0) 2))
-        (if (string-match " +" docstring (match-beginning 0))
-            (setq doc (substring docstring (match-end 0) end))
-          (setq doc "")))
-
-       ;; XEmacs subr docstring style:
-       ;;   "arguments: (arg1 arg2 ...)
-       ((string-match "^arguments: (\\([^\n)]+\\))" docstring)
-        ;; Also, skip leading paren, but the first word is actually an
-        ;; argument, not the function name.
-        (setq doc (substring docstring
-                             (match-beginning 1)
-                             (match-end 1))))
-
-       ;; This finds the argstring for `condition-case'.
-       ;; I don't know if there are any others with the same pattern.
-       ((string-match (format "^Usage looks like \\((%s[^\n)]*)\\)\\.$" fn)
-                      docstring)
-        ;; end does not include trailing ")" sequence.
-        (setq end (- (match-end 1) 1))
-        (if (string-match " +" docstring (match-beginning 1))
-            (setq doc (substring docstring (match-end 0) end))
-          (setq doc "")))
-
-       ;; This finds the argstring for `setq-default'.
-       ;; I don't know if there are any others with the same pattern.
-       ((string-match (format "^[ \t]+\\((%s[^\n)]*)\\)$" fn) docstring)
-        ;; end does not include trailing ")" sequence.
-        (setq end (- (match-end 1) 1))
-        (if (string-match " +" docstring (match-beginning 1))
-            (setq doc (substring docstring (match-end 0) end))
-          (setq doc "")))
-
-       ;; This finds the argstring for `start-process'.
-       ;; I don't know if there are any others with the same pattern.
-       ((string-match "^Args are +\\([^\n]+\\)$" docstring)
-        (setq doc (substring docstring (match-beginning 1) (match-end 1))))
-       )
-
-      (cond ((not (stringp doc))
-             nil)
-            ((string-match "&" doc)
-             (let ((p 0)
-                   (l (length doc)))
-               (while (< p l)
-                 (cond ((string-match "[ \t\n]+" doc p)
-                        (setq doclist
-                              (cons (substring doc p (match-beginning 0))
-                                    doclist))
-                        (setq p (match-end 0)))
-                       (t
-                        (setq doclist (cons (substring doc p) doclist))
-                        (setq p l))))
-               (eldoc-function-argstring-format (nreverse doclist))))
-            (t
-             (concat "(" (funcall eldoc-argument-case doc) ")"))))))
-
-(defun eldoc-function-argstring-format (arglist)
-  (cond ((not (listp arglist))
-         (setq arglist nil))
-        ((symbolp (car arglist))
-         (setq arglist
-               (mapcar (function (lambda (s)
-                                   (if (memq s '(&optional &rest))
-                                       (symbol-name s)
-                                     (funcall eldoc-argument-case
-                                              (symbol-name s)))))
-                       arglist)))
-        ((stringp (car arglist))
-         (setq arglist
-               (mapcar (function (lambda (s)
-                                   (if (member s '("&optional" "&rest"))
-                                       s
-                                     (funcall eldoc-argument-case s))))
-                       arglist))))
-  (concat "(" (mapconcat 'identity arglist " ") ")"))
-
-
-;; forward-sexp calls scan-sexps, which returns an error if it hits the
-;; beginning or end of the sexp.  This returns nil instead.
-(defun eldoc-forward-sexp-safe (&optional count)
-  "Move forward across one balanced expression (sexp).
-With argument, do it that many times.  Negative arg -COUNT means
-move backward across COUNT balanced expressions.
-Return distance in buffer moved, or nil."
-  (or count (setq count 1))
-  (condition-case err
-      (- (- (point) (progn
-                      (let ((parse-sexp-ignore-comments t))
-                        (forward-sexp count))
-                      (point))))
-    (error nil)))
-
-;; Do indirect function resolution if possible.
-(defun eldoc-symbol-function (fsym)
-  (let ((defn (and (fboundp fsym)
-                   (symbol-function fsym))))
-    (and (symbolp defn)
-         (condition-case err
-             (setq defn (indirect-function fsym))
-           (error (setq defn nil))))
-    defn))
-
-(defun eldoc-current-symbol ()
-  (let ((c (char-after (point))))
-    (and c
-         (memq (char-syntax c) '(?w ?_))
-         (intern-soft (current-word)))))
-
-(provide 'eldoc)
-
-;;; eldoc.el ends here
diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el
deleted file mode 100644
index 7c07e900b38..00000000000
--- a/lisp/emacs-lisp/elp.el
+++ /dev/null
@@ -1,563 +0,0 @@
-;;; elp.el --- Emacs Lisp Profiler
-
-;; Copyright (C) 1994 Free Software Foundation, Inc.
-
-;; Author: 1994 Barry A. Warsaw <bwarsaw@cnri.reston.va.us>
-;; Maintainer:    tools-help@anthem.nlm.nih.gov
-;; Created:       26-Feb-1994
-;; Version:       2.23
-;; Last Modified: 1994/12/28 22:39:31
-;; Keywords:      Emacs Lisp Profile Timing
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-;;
-;; If you want to profile a bunch of functions, set elp-function-list
-;; to the list of symbols, then do a M-x elp-instrument-list.  This
-;; hacks those functions so that profiling information is recorded
-;; whenever they are called.  To print out the current results, use
-;; M-x elp-results.  With elp-reset-after-results set to non-nil,
-;; profiling information will be reset whenever the results are
-;; displayed.  You can also reset all profiling info at any time with
-;; M-x elp-reset-all.
-;;
-;; You can also instrument all functions in a package, provided that
-;; the package follows the GNU coding standard of a common textural
-;; prefix.  Use M-x elp-instrument-package for this.
-;;
-;; If you want to sort the results, set elp-sort-by-function to some
-;; predicate function.  The three most obvious choices are predefined:
-;; elp-sort-by-call-count, elp-sort-by-average-time, and
-;; elp-sort-by-total-time.  Also, you can prune from the output, all
-;; functions that have been called fewer than a given number of times
-;; by setting elp-report-limit.
-;;
-;; Elp can instrument byte-compiled functions just as easily as
-;; interpreted functions, but it cannot instrument macros.  However,
-;; when you redefine a function (e.g. with eval-defun), you'll need to
-;; re-instrument it with M-x elp-instrument-function.  This will also
-;; reset profiling information for that function.  Elp can handle
-;; interactive functions (i.e. commands), but of course any time spent
-;; idling for user prompts will show up in the timing results.
-;;
-;; You can also designate a `master' function.  Profiling times will
-;; be gathered for instrumented functions only during execution of
-;; this master function.  Thus, if you have some defuns like:
-;;
-;;  (defun foo () (do-something-time-intensive))
-;;  (defun bar () (foo))
-;;  (defun baz () (bar) (foo))
-;;
-;; and you want to find out the amount of time spent in bar and foo,
-;; but only during execution of bar, make bar the master.  The call of
-;; foo from baz will not add to foo's total timing sums.  Use M-x
-;; elp-set-master and M-x elp-unset-master to utilize this feature.
-;; Only one master function can be set at a time.
-
-;; You can restore any function's original function definition with
-;; elp-restore-function.  The other instrument, restore, and reset
-;; functions are provided for symmetry.
-
-;; Note that there are plenty of factors that could make the times
-;; reported unreliable, including the accuracy and granularity of your
-;; system clock, and the overhead spent in lisp calculating and
-;; recording the intervals.  The latter I figure is pretty constant
-;; so, while the times may not be entirely accurate, I think they'll
-;; give you a good feel for the relative amount of work spent in the
-;; various lisp routines you are profiling.  Note further that times
-;; are calculated using wall-clock time, so other system load will
-;; affect accuracy too.
-
-;; Here is a list of variable you can use to customize elp:
-;;   elp-function-list
-;;   elp-reset-after-results
-;;   elp-sort-by-function
-;;   elp-report-limit
-;;
-;; Here is a list of the interactive commands you can use:
-;;   elp-instrument-function
-;;   elp-restore-function
-;;   elp-instrument-list
-;;   elp-restore-list
-;;   elp-instrument-package
-;;   elp-restore-all
-;;   elp-reset-function
-;;   elp-reset-list
-;;   elp-reset-all
-;;   elp-set-master
-;;   elp-unset-master
-;;   elp-results
-;;   elp-submit-bug-report
-
-;; Note that there are plenty of factors that could make the times
-;; reported unreliable, including the accuracy and granularity of your
-;; system clock, and the overhead spent in lisp calculating and
-;; recording the intervals.  I figure the latter is pretty constant,
-;; so while the times may not be entirely accurate, I think they'll
-;; give you a good feel for the relative amount of work spent in the
-;; various lisp routines you are profiling.  Note further that times
-;; are calculated using wall-clock time, so other system load will
-;; affect accuracy too.  You cannot profile anything longer than ~18
-;; hours since I throw away the most significant 16 bits of seconds
-;; returned by current-time: 2^16 == 65536 seconds == ~1092 minutes ==
-;; ~18 hours.  I doubt you will ever want to profile stuff on the
-;; order of 18 hours anyway.
-
-;;; Background:
-
-;; This program is based on the only two existing Emacs Lisp profilers
-;; that I'm aware of, Boaz Ben-Zvi's profile.el, and Root Boy Jim's
-;; profiler.el. Both were written for Emacs 18 and both were pretty
-;; good first shots at profiling, but I found that they didn't provide
-;; the functionality or interface that I wanted.  So I wrote this.
-;; I've tested elp in GNU Emacs 19 and in GNU XEmacs.  There's no
-;; point in even trying to make this work with Emacs 18.
-
-;; Unlike previous profilers, elp uses Emacs 19's built-in function
-;; current-time to return interval times.  This obviates the need for
-;; both an external C program and Emacs processes to communicate with
-;; such a program, and thus simplifies the package as a whole.
-
-;;; Code:
-
-
-;; start user configuration variables
-;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
-
-(defvar elp-function-list nil
-  "*List of function to profile.")
-
-(defvar elp-reset-after-results t
-  "*Non-nil means reset all profiling info after results are displayed.
-Results are displayed with the `elp-results' command.")
-
-(defvar elp-sort-by-function nil
-  "*Non-nil specifies elp results sorting function.
-These functions are currently available:
-
-  elp-sort-by-call-count   -- sort by the highest call count
-  elp-sort-by-total-time   -- sort by the highest total time
-  elp-sort-by-average-time -- sort by the highest average times
-
-You can write you're own sort function. It should adhere to the
-interface specified by the PRED argument for the `sort' defun.  Each
-\"element of LIST\" is really a 4 element vector where element 0 is
-the call count, element 1 is the total time spent in the function,
-element 2 is the average time spent in the function, and element 3 is
-the symbol's name string.")
-
-(defvar elp-report-limit nil
-  "*Prevents some functions from being displayed in the results buffer.
-If a number, no function that has been called fewer than that number
-of times will be displayed in the output buffer.  If nil, all
-functions will be displayed.")
-
-
-;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-;; end user configuration variables
-
-
-(defconst elp-version "2.23"
-  "ELP version number.")
-
-(defconst elp-help-address "tools-help@anthem.nlm.nih.gov"
-  "Address accepting submissions of bug reports and questions.")
-
-(defvar elp-results-buffer "*ELP Profiling Results*"
-  "Buffer name for outputting profiling results.")
-
-(defconst elp-timer-info-property 'elp-info
-  "ELP information property name.")
-
-(defvar elp-all-instrumented-list nil
-  "List of all functions currently being instrumented.")
-
-(defvar elp-record-p t
-  "Controls whether functions should record times or not.
-This variable is set by the master function.")
-
-(defvar elp-master nil
-  "Master function symbol.")
-
-
-;;;###autoload
-(defun elp-instrument-function (funsym)
-  "Instrument FUNSYM for profiling.
-FUNSYM must be a symbol of a defined function."
-  (interactive "aFunction to instrument: ")
-  ;; TBD what should we do if the function is already instrumented???
-  (let* ((funguts (symbol-function funsym))
-	 (infovec (vector 0 0 funguts))
-	 (newguts '(lambda (&rest args))))
-    ;; we cannot profile macros
-    (and (eq (car-safe funguts) 'macro)
-	 (error "ELP cannot profile macro %s" funsym))
-    ;; put rest of newguts together
-    (if (commandp funsym)
-	(setq newguts (append newguts '((interactive)))))
-    (setq newguts (append newguts (list
-				   (list 'elp-wrapper
-					 (list 'quote funsym)
-					 (list 'and
-					       '(interactive-p)
-					       (not (not (commandp funsym))))
-					 'args))))
-    ;; to record profiling times, we set the symbol's function
-    ;; definition so that it runs the elp-wrapper function with the
-    ;; function symbol as an argument.  We place the old function
-    ;; definition on the info vector.
-    ;;
-    ;; The info vector data structure is a 3 element vector.  The 0th
-    ;; element is the call-count, i.e. the total number of times this
-    ;; function has been entered.  This value is bumped up on entry to
-    ;; the function so that non-local exists are still recorded. TBD:
-    ;; I haven't tested non-local exits at all, so no guarantees.
-    ;;
-    ;; The 1st element is the total amount of time in usecs that have
-    ;; been spent inside this function.  This number is added to on
-    ;; function exit.
-    ;;
-    ;; The 2nd element is the old function definition list.  This gets
-    ;; funcall'd in between start/end time retrievals. I believe that
-    ;; this lets us profile even byte-compiled functions.
-
-    ;; put the info vector on the property list
-    (put funsym elp-timer-info-property infovec)
-
-    ;; set the symbol's new profiling function definition to run
-    ;; elp-wrapper
-    (fset funsym newguts)
-
-    ;; add this function to the instrumentation list
-    (or (memq funsym elp-all-instrumented-list)
-	(setq elp-all-instrumented-list
-	      (cons funsym elp-all-instrumented-list)))
-    ))
-
-;;;###autoload
-(defun elp-restore-function (funsym)
-  "Restore an instrumented function to its original definition.
-Argument FUNSYM is the symbol of a defined function."
-  (interactive "aFunction to restore: ")
-  (let ((info (get funsym elp-timer-info-property)))
-    ;; delete the function from the all instrumented list
-    (setq elp-all-instrumented-list
-	  (delq funsym elp-all-instrumented-list))
-
-    ;; if the function was the master, reset the master
-    (if (eq funsym elp-master)
-	(setq elp-master nil
-	      elp-record-p t))
-
-    ;; zap the properties
-    (put funsym elp-timer-info-property nil)
-
-    ;; restore the original function definition, but if the function
-    ;; wasn't instrumented do nothing.  we do this after the above
-    ;; because its possible the function got un-instrumented due to
-    ;; circumstances beyond our control.  Also, check to make sure
-    ;; that the current function symbol points to elp-wrapper.  If
-    ;; not, then the user probably did an eval-defun while the
-    ;; function was instrumented and we don't want to destroy the new
-    ;; definition.
-    (and info
-	 (assq 'elp-wrapper (symbol-function funsym))
-	 (fset funsym (aref info 2)))))
-
-;;;###autoload
-(defun elp-instrument-list (&optional list)
-  "Instrument for profiling, all functions in `elp-function-list'.
-Use optional LIST if provided instead."
-  (interactive "PList of functions to instrument: ")
-  (let ((list (or list elp-function-list)))
-    (mapcar 'elp-instrument-function list)))
-
-;;;###autoload
-(defun elp-instrument-package (prefix)
-  "Instrument for profiling, all functions which start with PREFIX.
-For example, to instrument all ELP functions, do the following:
-
-    \\[elp-instrument-package] RET elp- RET"
-  (interactive "sPrefix of package to instrument: ")
-  (elp-instrument-list
-   (mapcar 'intern (all-completions prefix obarray
-				    (function
-				     (lambda (sym)
-				       (and (fboundp sym)
-					    (not (memq (car-safe
-							(symbol-function sym))
-						       '(macro keymap autoload))))))))))
-
-(defun elp-restore-list (&optional list)
-  "Restore the original definitions for all functions in `elp-function-list'.
-Use optional LIST if provided instead."
-  (interactive "PList of functions to restore: ")
-  (let ((list (or list elp-function-list)))
-    (mapcar 'elp-restore-function list)))
-
-(defun elp-restore-all ()
-  "Restores the original definitions of all functions being profiled."
-  (interactive)
-  (elp-restore-list elp-all-instrumented-list))
-
-
-(defun elp-reset-function (funsym)
-  "Reset the profiling information for FUNSYM."
-  (interactive "aFunction to reset: ")
-  (let ((info (get funsym elp-timer-info-property)))
-    (or info
-	(error "%s is not instrumented for profiling." funsym))
-    (aset info 0 0)			;reset call counter
-    (aset info 1 0.0)			;reset total time
-    ;; don't muck with aref 2 as that is the old symbol definition
-    ))
-
-(defun elp-reset-list (&optional list)
-  "Reset the profiling information for all functions in `elp-function-list'.
-Use optional LIST if provided instead."
-  (interactive "PList of functions to reset: ")
-  (let ((list (or list elp-function-list)))
-    (mapcar 'elp-reset-function list)))
-
-(defun elp-reset-all ()
-  "Reset the profiling information for all functions being profiled."
-  (interactive)
-  (elp-reset-list elp-all-instrumented-list))
-
-(defun elp-set-master (funsym)
-  "Set the master function for profiling."
-  (interactive "aMaster function: ")
-  ;; when there's a master function, recording is turned off by
-  ;; default
-  (setq elp-master funsym
-	elp-record-p nil)
-  ;; make sure master function is instrumented
-  (or (memq funsym elp-all-instrumented-list)
-      (elp-instrument-function funsym)))
-
-(defun elp-unset-master ()
-  "Unsets the master function."
-  (interactive)
-  ;; when there's no master function, recording is turned on by default.
-  (setq elp-master nil
-	elp-record-p t))
-
-
-(defsubst elp-get-time ()
-  ;; get current time in seconds and microseconds. I throw away the
-  ;; most significant 16 bits of seconds since I doubt we'll ever want
-  ;; to profile lisp on the order of 18 hours. See notes at top of file.
-  (let ((now (current-time)))
-    (+ (float (nth 1 now)) (/ (float (nth 2 now)) 1000000.0))))
-
-(defun elp-wrapper (funsym interactive-p args)
-  "This function has been instrumented for profiling by the ELP.
-ELP is the Emacs Lisp Profiler.  To restore the function to its
-original definition, use \\[elp-restore-function] or \\[elp-restore-all]."
-  ;; turn on recording if this is the master function
-  (if (and elp-master
-	   (eq funsym elp-master))
-      (setq elp-record-p t))
-  ;; get info vector and original function symbol
-  (let* ((info (get funsym elp-timer-info-property))
-	 (func (aref info 2))
-	 result)
-    (or func
-	(error "%s is not instrumented for profiling." funsym))
-    (if (not elp-record-p)
-	;; when not recording, just call the original function symbol
-	;; and return the results.
-	(setq result
-	      (if interactive-p
-		  (call-interactively func)
-		(apply func args)))
-      ;; we are recording times
-      (let ((enter-time (elp-get-time)))
-	;; increment the call-counter
-	(aset info 0 (1+ (aref info 0)))
-	;; now call the old symbol function, checking to see if it
-	;; should be called interactively.  make sure we return the
-	;; correct value
-	(setq result
-	      (if interactive-p
-		  (call-interactively func)
-		(apply func args)))
-	;; calculate total time in function
-	(aset info 1 (+ (aref info 1) (- (elp-get-time) enter-time)))
-	))
-    ;; turn off recording if this is the master function
-    (if (and elp-master
-	     (eq funsym elp-master))
-	(setq elp-record-p nil))
-    result))
-
-
-;; shut the byte-compiler up
-(defvar elp-field-len nil)
-(defvar elp-cc-len nil)
-(defvar elp-at-len nil)
-(defvar elp-et-len nil)
-
-(defun elp-sort-by-call-count (vec1 vec2)
-  ;; sort by highest call count.  See `sort'.
-  (>= (aref vec1 0) (aref vec2 0)))
-
-(defun elp-sort-by-total-time (vec1 vec2)
-  ;; sort by highest total time spent in function. See `sort'.
-  (>= (aref vec1 1) (aref vec2 1)))
-
-(defun elp-sort-by-average-time (vec1 vec2)
-  ;; sort by highest average time spent in function. See `sort'.
-  (>= (aref vec1 2) (aref vec2 2)))
-
-(defsubst elp-pack-number (number width)
-  ;; pack the NUMBER string into WIDTH characters, watching out for
-  ;; very small or large numbers
-  (if (<= (length number) width)
-      number
-    ;; check for very large or small numbers
-    (if (string-match "^\\(.*\\)\\(e[+-].*\\)$" number)
-	(concat (substring
-		 (substring number (match-beginning 1) (match-end 1))
-		 0
-		 (- width (match-end 2) (- (match-beginning 2)) 3))
-		"..."
-		(substring number (match-beginning 2) (match-end 2)))
-      (concat (substring number 0 width)))))
-
-(defun elp-output-result (resultvec)
-  ;; output the RESULTVEC into the results buffer. RESULTVEC is a 4 or
-  ;; more element vector where aref 0 is the call count, aref 1 is the
-  ;; total time spent in the function, aref 2 is the average time
-  ;; spent in the function, and aref 3 is the symbol's string
-  ;; name. All other elements in the vector are ignored.
-  (let* ((cc (aref resultvec 0))
-	 (tt (aref resultvec 1))
-	 (at (aref resultvec 2))
-	 (symname (aref resultvec 3))
-	 callcnt totaltime avetime)
-    (setq callcnt (number-to-string cc)
-	  totaltime (number-to-string tt)
-	  avetime (number-to-string at))
-    ;; possibly prune the results
-    (if (and elp-report-limit
-	     (numberp elp-report-limit)
-	     (< cc elp-report-limit))
-	nil
-      (insert symname)
-      (insert-char 32 (+ elp-field-len (- (length symname)) 2))
-      ;; print stuff out, formatting it nicely
-      (insert callcnt)
-      (insert-char 32 (+ elp-cc-len (- (length callcnt)) 2))
-      (let ((ttstr (elp-pack-number totaltime elp-et-len))
-	    (atstr (elp-pack-number avetime elp-at-len)))
-	(insert ttstr)
-	(insert-char 32 (+ elp-et-len (- (length ttstr)) 2))
-	(insert atstr))
-      (insert "\n"))))
-
-;;;###autoload
-(defun elp-results ()
-  "Display current profiling results.
-If `elp-reset-after-results' is non-nil, then current profiling
-information for all instrumented functions are reset after results are
-displayed."
-  (interactive)
-  (let ((curbuf (current-buffer))
-	(resultsbuf (get-buffer-create elp-results-buffer)))
-    (set-buffer resultsbuf)
-    (erase-buffer)
-    (beginning-of-buffer)
-    ;; get the length of the longest function name being profiled
-    (let* ((longest 0)
-	   (title "Function Name")
-	   (titlelen (length title))
-	   (elp-field-len titlelen)
-	   (cc-header "Call Count")
-	   (elp-cc-len    (length cc-header))
-	   (et-header "Elapsed Time")
-	   (elp-et-len    (length et-header))
-	   (at-header "Average Time")
-	   (elp-at-len    (length at-header))
-	   (resvec
-	    (mapcar
-	     (function
-	      (lambda (funsym)
-		(let* ((info (get funsym elp-timer-info-property))
-		       (symname (format "%s" funsym))
-		       (cc (aref info 0))
-		       (tt (aref info 1)))
-		  (if (not info)
-		      (insert "No profiling information found for: "
-			      symname)
-		    (setq longest (max longest (length symname)))
-		    (vector cc tt (if (zerop cc)
-				      0.0 ;avoid arithmetic div-by-zero errors
-				    (/ (float tt) (float cc)))
-			    symname)))))
-	     elp-all-instrumented-list))
-	   )				; end let*
-      (insert title)
-      (if (> longest titlelen)
-	  (progn
-	    (insert-char 32 (- longest titlelen))
-	    (setq elp-field-len longest)))
-      (insert "  " cc-header "  " et-header "  " at-header "\n")
-      (insert-char ?= elp-field-len)
-      (insert "  ")
-      (insert-char ?= elp-cc-len)
-      (insert "  ")
-      (insert-char ?= elp-et-len)
-      (insert "  ")
-      (insert-char ?= elp-at-len)
-      (insert "\n")
-      ;; if sorting is enabled, then sort the results list. in either
-      ;; case, call elp-output-result to output the result in the
-      ;; buffer
-      (if elp-sort-by-function
-	  (setq resvec (sort resvec elp-sort-by-function)))
-      (mapcar 'elp-output-result resvec))
-    ;; now pop up results buffer
-    (set-buffer curbuf)
-    (pop-to-buffer resultsbuf)
-    ;; reset profiling info if desired
-    (and elp-reset-after-results
-	 (elp-reset-all))))
-
-
-(eval-when-compile
- (require 'reporter))
-
-;;;###autoload
-(defun elp-submit-bug-report ()
-  "Submit via mail, a bug report on elp."
-  (interactive)
-  (and
-   (y-or-n-p "Do you want to submit a report on elp? ")
-   (require 'reporter)
-   (reporter-submit-bug-report
-    elp-help-address (concat "elp " elp-version)
-    '(elp-report-limit
-      elp-reset-after-results
-      elp-sort-by-function))))
-
-
-(provide 'elp)
-
-;; elp.el ends here
diff --git a/lisp/emacs-lisp/eval-reg.el b/lisp/emacs-lisp/eval-reg.el
deleted file mode 100644
index d97a4ea46de..00000000000
--- a/lisp/emacs-lisp/eval-reg.el
+++ /dev/null
@@ -1,219 +0,0 @@
-;;; eval-reg.el --- Redefine eval-region, and subrs that use it, in Lisp
-
-;; Copyright (C) 1994, 1996 Daniel LaLiberte
-
-;; Author: Daniel LaLiberte <liberte@cs.uiuc.edu>
-;; Keywords: lisp
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; eval-region, eval-buffer, and eval-current-buffer are redefined in
-;; Lisp to allow customizations by Lisp code.  eval-region calls
-;; `read', `eval', and `prin1', so Lisp replacements of these
-;; functions will affect eval-region and anything else that calls it.
-;; eval-buffer and eval-current-buffer are redefined in Lisp to call
-;; eval-region on the buffer.  
-
-;; Because of dynamic binding, all local variables are protected from
-;; being seen by eval by giving them funky names.  But variables in
-;; routines that call eval-region are similarly exposed.
-
-;; Perhaps this should be one of several files in an `elisp' package
-;; that replaces Emacs Lisp subroutines with Lisp versions of the
-;; same.
-
-;; Eval-region may be installed, after loading, by calling:
-;; (elisp-eval-region-install).  Installation can be undone with:
-;; (elisp-eval-region-uninstall).
-
-;;; Code:
-
-'(defpackage "elisp-eval-region"
-   (:nicknames "elisp")
-   (:use "elisp")
-   (:export
-    elisp-eval-region-install
-    elisp-eval-region-uninstall
-    elisp-eval-region-level
-    with-elisp-eval-region
-    eval-region
-    eval-buffer
-    eval-current-buffer
-    ))
-'(in-package elisp-eval-region)
-
-;; Save standard versions.
-(if (not (fboundp 'original-eval-region))
-    (defalias 'original-eval-region (symbol-function 'eval-region)))
-(if (not (fboundp 'original-eval-buffer))
-    (defalias 'original-eval-buffer 
-	  (if (fboundp 'eval-buffer)  ;; only in Emacs 19
-	      (symbol-function 'eval-buffer)
-	    'undefined)))
-(if (not (fboundp 'original-eval-current-buffer))
-    (defalias 'original-eval-current-buffer
-	  (symbol-function 'eval-current-buffer)))
-
-(defvar elisp-eval-region-level 0
-  "If the value is 0, use the original version of `elisp-eval-region'.
-Callers of `elisp-eval-region' should increment `elisp-eval-region-level'
-while the Lisp version should be used.  Installing `elisp-eval-region'
-increments it once, and uninstalling decrements it.")
-
-;; Installing and uninstalling should always be used in pairs, 
-;; or just install once and never uninstall. 
-(defun elisp-eval-region-install ()
-  (interactive)
-  (defalias 'eval-region 'elisp-eval-region)
-  (defalias 'eval-buffer 'elisp-eval-buffer)
-  (defalias 'eval-current-buffer 'elisp-eval-current-buffer)
-  (setq elisp-eval-region-level (1+ elisp-eval-region-level)))
-
-(defun elisp-eval-region-uninstall ()
-  (interactive)
-  (if (> 1 elisp-eval-region-level)
-      (setq elisp-eval-region-level (1- elisp-eval-region-level))
-    (setq elisp-eval-region-level 0)
-    (defalias 'eval-region (symbol-function 'original-eval-region))
-    (defalias 'eval-buffer (symbol-function 'original-eval-buffer))
-    (defalias 'eval-current-buffer 
-      (symbol-function 'original-eval-current-buffer))
-    ))
-
-(put 'with-elisp-eval-region 'lisp-indent-function 1)
-(put 'with-elisp-eval-region 'lisp-indent-hook 1)
-(put 'with-elisp-eval-region 'edebug-form-spec t)
-
-(defmacro with-elisp-eval-region (flag &rest body)
-  "If FLAG is nil, decrement `eval-region-level' while executing BODY.
-The effect of decrementing all the way to zero is that `eval-region'
-will use the original `eval-region', which may be the Emacs subr or some
-previous redefinition.  Before calling this macro, this package should
-already have been installed, using `elisp-eval-region-install', which
-increments the count once.  So if another package still requires the
-Lisp version of the code, the count will still be non-zero.
-
-The count is not bound locally by this macro, so changes by BODY to
-its value will not be lost."
-  (` (let ((elisp-code (function (lambda () (,@ body)))))
-       (if (not (, flag))
-	   (unwind-protect
-	       (progn
-		 (setq elisp-eval-region-level (1- elisp-eval-region-level))
-		 (funcall elisp-code))
-	     (setq elisp-eval-region-level (1+ elisp-eval-region-level)))
-	 (funcall elisp-code)))))
-
-
-(defun elisp-eval-region (elisp-start elisp-end &optional elisp-output)
-  "Execute the region as Lisp code.
-When called from programs, expects two arguments,
-giving starting and ending indices in the current buffer
-of the text to be executed.
-Programs can pass third argument PRINTFLAG which controls printing of output:
-nil means discard it; anything else is stream for print.
-
-This version, from `eval-reg.el', allows Lisp customization of read,
-eval, and the printer."
-
-  ;; Because this doesn't narrow to the region, one other difference 
-  ;; concerns inserting whitespace after the expression being evaluated.
-
-  (interactive "r")
-  (if (= 0 elisp-eval-region-level)
-      (original-eval-region elisp-start elisp-end elisp-output)
-    (let ((elisp-pnt (point))
-	  (elisp-buf (current-buffer));; Outside buffer
-	  (elisp-inside-buf (current-buffer));; Buffer current while evalling
-	  ;; Mark the end because it may move.
-	  (elisp-end-marker (set-marker (make-marker) elisp-end))
-	  elisp-form
-	  elisp-val)
-      (goto-char elisp-start)
-      (elisp-skip-whitespace)
-      (while (< (point) elisp-end-marker)
-	(setq elisp-form (read elisp-buf))
-
-	(let ((elisp-current-buffer (current-buffer)))
-	  ;; Restore the inside current-buffer.
-	  (set-buffer elisp-inside-buf)
-	  (setq elisp-val (eval elisp-form))
-	  ;; Remember current buffer for next time.
-	  (setq elisp-inside-buf (current-buffer))
-	  ;; Should this be protected?
-	  (set-buffer elisp-current-buffer))
-
-	(if elisp-output
-	    (let ((standard-output (or elisp-output t)))
-	      (setq values (cons elisp-val values))
-	      (if (eq standard-output t)
-		  (prin1 elisp-val)
-		(princ "\n")
-		(prin1 elisp-val)
-		(princ "\n")
-		)))
-	(goto-char (min (max elisp-end-marker (point))
-			(progn (elisp-skip-whitespace) (point))))
-	)				; while
-      (if elisp-output nil
-	;; like save-excursion recovery, but done only if no error occurs
-	;; but mark is not restored
-	(set-buffer elisp-buf)
-	(goto-char elisp-pnt))
-      nil)))
-
-
-(defun elisp-skip-whitespace ()
-  ;; Leave point before the next token, skipping white space and comments.
-  (skip-chars-forward " \t\r\n\f")
-  (while (= (following-char) ?\;)
-    (skip-chars-forward "^\n\r")  ; skip the comment
-    (skip-chars-forward " \t\r\n\f")))
-
-
-(defun elisp-eval-current-buffer (&optional elisp-output)
-  "Execute the current buffer as Lisp code.
-Programs can pass argument PRINTFLAG which controls printing of output:
-nil means discard it; anything else is stream for print.
-
-This version calls `eval-region' on the whole buffer."
-  ;; The standard eval-current-buffer doesn't use eval-region.
-  (interactive)
-  (eval-region (point-min) (point-max) elisp-output))
-
-
-(defun elisp-eval-buffer (&optional elisp-bufname elisp-printflag)
-  "Execute BUFFER as Lisp code.  Use current buffer if BUFFER is nil.
-Programs can pass argument PRINTFLAG which controls printing of
-output: nil means discard it; anything else is stream for print.
-
-This version calls `eval-region' on the whole buffer."
-  (interactive)
-  (if (null elisp-bufname)
-      (setq elisp-bufname (current-buffer)))
-  (save-excursion
-    (set-buffer (or (get-buffer elisp-bufname) 
-		    (error "No such buffer: %s" elisp-bufname)))
-    (eval-region (point-min) (point-max) elisp-printflag)))
-
-
-(provide 'eval-reg)
-
-;;; eval-reg.el ends here
diff --git a/lisp/emacs-lisp/float.el b/lisp/emacs-lisp/float.el
deleted file mode 100644
index f4fd9ae0ec9..00000000000
--- a/lisp/emacs-lisp/float.el
+++ /dev/null
@@ -1,458 +0,0 @@
-;;; float.el --- floating point arithmetic package.
-
-;; Copyright (C) 1986 Free Software Foundation, Inc.
-
-;; Author: Bill Rosenblatt
-;; Maintainer: FSF
-;; Keywords: extensions
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Floating point numbers are represented by dot-pairs (mant . exp)
-;; where mant is the 24-bit signed integral mantissa and exp is the
-;; base 2 exponent.
-;;
-;; Emacs LISP supports a 24-bit signed integer data type, which has a
-;; range of -(2**23) to +(2**23)-1, or -8388608 to 8388607 decimal.
-;; This gives six significant decimal digit accuracy.  Exponents can
-;; be anything in the range -(2**23) to +(2**23)-1.
-;;
-;; User interface:
-;; function f converts from integer to floating point
-;; function string-to-float converts from string to floating point
-;; function fint converts a floating point to integer (with truncation)
-;; function float-to-string converts from floating point to string
-;;                   
-;; Caveats:
-;; -  Exponents outside of the range of +/-100 or so will cause certain 
-;;    functions (especially conversion routines) to take forever.
-;; -  Very little checking is done for fixed point overflow/underflow.
-;; -  No checking is done for over/underflow of the exponent
-;;    (hardly necessary when exponent can be 2**23).
-;; 
-;;
-;; Bill Rosenblatt
-;; June 20, 1986
-;;
-
-;;; Code:
-
-;; fundamental implementation constants
-(defconst exp-base 2
-  "Base of exponent in this floating point representation.")
-
-(defconst mantissa-bits 24
-  "Number of significant bits in this floating point representation.")
-
-(defconst decimal-digits 6
-  "Number of decimal digits expected to be accurate.")
-
-(defconst expt-digits 2
-  "Maximum permitted digits in a scientific notation exponent.")
-
-;; other constants
-(defconst maxbit (1- mantissa-bits)
-  "Number of highest bit")
-
-(defconst mantissa-maxval (1- (ash 1 maxbit))
-  "Maximum permissible value of mantissa")
-
-(defconst mantissa-minval (ash 1 maxbit)
-  "Minimum permissible value of mantissa")
-
-(defconst floating-point-regexp
-  "^[ \t]*\\(-?\\)\\([0-9]*\\)\
-\\(\\.\\([0-9]*\\)\\|\\)\
-\\(\\(\\([Ee]\\)\\(-?\\)\\([0-9][0-9]*\\)\\)\\|\\)[ \t]*$"
-  "Regular expression to match floating point numbers.  Extract matches:
-1 - minus sign
-2 - integer part
-4 - fractional part
-8 - minus sign for power of ten
-9 - power of ten
-")
-
-(defconst high-bit-mask (ash 1 maxbit)
-  "Masks all bits except the high-order (sign) bit.")
-
-(defconst second-bit-mask (ash 1 (1- maxbit))
-  "Masks all bits except the highest-order magnitude bit")
-
-;; various useful floating point constants
-(setq _f0 '(0 . 1))
-
-(setq _f1/2 '(4194304 . -23))
-
-(setq _f1 '(4194304 . -22))
-
-(setq _f10 '(5242880 . -19))
-
-;; support for decimal conversion routines
-(setq powers-of-10 (make-vector (1+ decimal-digits) _f1))
-(aset powers-of-10 1 _f10)
-(aset powers-of-10 2 '(6553600 . -16))
-(aset powers-of-10 3 '(8192000 . -13))
-(aset powers-of-10 4 '(5120000 . -9))
-(aset powers-of-10 5 '(6400000 . -6))
-(aset powers-of-10 6 '(8000000 . -3))
-
-(setq all-decimal-digs-minval (aref powers-of-10 (1- decimal-digits))
-      highest-power-of-10 (aref powers-of-10 decimal-digits))
-
-(defun fashl (fnum)			; floating-point arithmetic shift left
-  (cons (ash (car fnum) 1) (1- (cdr fnum))))
-
-(defun fashr (fnum)			; floating point arithmetic shift right
-  (cons (ash (car fnum) -1) (1+ (cdr fnum))))
-
-(defun normalize (fnum)
-  (if (> (car fnum) 0)			; make sure next-to-highest bit is set
-      (while (zerop (logand (car fnum) second-bit-mask))
-	(setq fnum (fashl fnum)))
-    (if (< (car fnum) 0)		; make sure highest bit is set
-	(while (zerop (logand (car fnum) high-bit-mask))
-	  (setq fnum (fashl fnum)))
-      (setq fnum _f0)))			; "standard 0"
-  fnum)
-      
-(defun abs (n)				; integer absolute value
-  (if (>= n 0) n (- n)))
-
-(defun fabs (fnum)			; re-normalize after taking abs value
-  (normalize (cons (abs (car fnum)) (cdr fnum))))
-
-(defun xor (a b)			; logical exclusive or
-  (and (or a b) (not (and a b))))
-
-(defun same-sign (a b)			; two f-p numbers have same sign?
-  (not (xor (natnump (car a)) (natnump (car b)))))
-
-(defun extract-match (str i)		; used after string-match
-  (condition-case ()
-      (substring str (match-beginning i) (match-end i))
-    (error "")))
-
-;; support for the multiplication function
-(setq halfword-bits (/ mantissa-bits 2)	; bits in a halfword
-      masklo (1- (ash 1 halfword-bits)) ; isolate the lower halfword
-      maskhi (lognot masklo)		; isolate the upper halfword
-      round-limit (ash 1 (/ halfword-bits 2)))
-
-(defun hihalf (n)			; return high halfword, shifted down
-  (ash (logand n maskhi) (- halfword-bits)))
-
-(defun lohalf (n)			; return low halfword
-  (logand n masklo))
-
-;; Visible functions
-
-;; Arithmetic functions
-(defun f+ (a1 a2)
-  "Returns the sum of two floating point numbers."
-  (let ((f1 (fmax a1 a2))
-	(f2 (fmin a1 a2)))
-    (if (same-sign a1 a2)
-	(setq f1 (fashr f1)		; shift right to avoid overflow
-	      f2 (fashr f2)))
-    (normalize
-     (cons (+ (car f1) (ash (car f2) (- (cdr f2) (cdr f1))))
-	   (cdr f1)))))
-
-(defun f- (a1 &optional a2)		; unary or binary minus
-  "Returns the difference of two floating point numbers."
-  (if a2
-      (f+ a1 (f- a2))
-    (normalize (cons (- (car a1)) (cdr a1)))))
-
-(defun f* (a1 a2)			; multiply in halfword chunks
-  "Returns the product of two floating point numbers."
-  (let* ((i1 (car (fabs a1)))
-	 (i2 (car (fabs a2)))
-	 (sign (not (same-sign a1 a2)))
-	 (prodlo (+ (hihalf (* (lohalf i1) (lohalf i2)))
-		    (lohalf (* (hihalf i1) (lohalf i2)))
-		    (lohalf (* (lohalf i1) (hihalf i2)))))
-	 (prodhi (+ (* (hihalf i1) (hihalf i2))
-		    (hihalf (* (hihalf i1) (lohalf i2)))
-		    (hihalf (* (lohalf i1) (hihalf i2)))
-		    (hihalf prodlo))))
-    (if (> (lohalf prodlo) round-limit)
-	(setq prodhi (1+ prodhi)))	; round off truncated bits
-    (normalize
-     (cons (if sign (- prodhi) prodhi)
-	   (+ (cdr (fabs a1)) (cdr (fabs a2)) mantissa-bits)))))
-
-(defun f/ (a1 a2)			; SLOW subtract-and-shift algorithm
-  "Returns the quotient of two floating point numbers."
-  (if (zerop (car a2))			; if divide by 0
-      (signal 'arith-error (list "attempt to divide by zero" a1 a2))
-    (let ((bits (1- maxbit))
-	  (quotient 0) 
-	  (dividend (car (fabs a1)))
-	  (divisor (car (fabs a2)))
-	  (sign (not (same-sign a1 a2))))
-      (while (natnump bits)
-	(if (< (- dividend divisor) 0)
-	    (setq quotient (ash quotient 1))
-	  (setq quotient (1+ (ash quotient 1))
-		dividend (- dividend divisor)))
-	(setq dividend (ash dividend 1)
-	      bits (1- bits)))
-      (normalize
-       (cons (if sign (- quotient) quotient)
-	     (- (cdr (fabs a1)) (cdr (fabs a2)) (1- maxbit)))))))
-  
-(defun f% (a1 a2)
-  "Returns the remainder of first floating point number divided by second."
-  (f- a1 (f* (ftrunc (f/ a1 a2)) a2)))
-	  
-
-;; Comparison functions
-(defun f= (a1 a2)
-  "Returns t if two floating point numbers are equal, nil otherwise."
-  (equal a1 a2))
-
-(defun f> (a1 a2)
-  "Returns t if first floating point number is greater than second,
-nil otherwise."
-  (cond ((and (natnump (car a1)) (< (car a2) 0)) 
-	 t)				; a1 nonnegative, a2 negative
-	((and (> (car a1) 0) (<= (car a2) 0))
-	 t)				; a1 positive, a2 nonpositive
-	((and (<= (car a1) 0) (natnump (car a2)))
-	 nil)				; a1 nonpos, a2 nonneg
-	((/= (cdr a1) (cdr a2))		; same signs.  exponents differ
-	 (> (cdr a1) (cdr a2)))		; compare the mantissas.
-	(t
-	 (> (car a1) (car a2)))))	; same exponents.
-
-(defun f>= (a1 a2)
-  "Returns t if first floating point number is greater than or equal to 
-second, nil otherwise."
-  (or (f> a1 a2) (f= a1 a2)))
-
-(defun f< (a1 a2)
-  "Returns t if first floating point number is less than second,
-nil otherwise."
-  (not (f>= a1 a2)))
-
-(defun f<= (a1 a2)
-  "Returns t if first floating point number is less than or equal to
-second, nil otherwise."
-  (not (f> a1 a2)))
-
-(defun f/= (a1 a2)
-  "Returns t if first floating point number is not equal to second,
-nil otherwise."
-  (not (f= a1 a2)))
-
-(defun fmin (a1 a2)
-  "Returns the minimum of two floating point numbers."
-  (if (f< a1 a2) a1 a2))
-
-(defun fmax (a1 a2)
-  "Returns the maximum of two floating point numbers."
-  (if (f> a1 a2) a1 a2))
-      
-(defun fzerop (fnum)
-  "Returns t if the floating point number is zero, nil otherwise."
-  (= (car fnum) 0))
-
-(defun floatp (fnum)
-  "Returns t if the arg is a floating point number, nil otherwise."
-  (and (consp fnum) (integerp (car fnum)) (integerp (cdr fnum))))
-
-;; Conversion routines
-(defun f (int)
-  "Convert the integer argument to floating point, like a C cast operator."
-  (normalize (cons int '0)))
-
-(defun int-to-hex-string (int)
-  "Convert the integer argument to a C-style hexadecimal string."
-  (let ((shiftval -20)
-	(str "0x")
-	(hex-chars "0123456789ABCDEF"))
-    (while (<= shiftval 0)
-      (setq str (concat str (char-to-string 
-			(aref hex-chars
-			      (logand (lsh int shiftval) 15))))
-	    shiftval (+ shiftval 4)))
-    str))
-
-(defun ftrunc (fnum)			; truncate fractional part
-  "Truncate the fractional part of a floating point number."
-  (cond ((natnump (cdr fnum))		; it's all integer, return number as is
-	 fnum)
-	((<= (cdr fnum) (- maxbit))	; it's all fractional, return 0
-	 '(0 . 1))
-	(t				; otherwise mask out fractional bits
-	 (let ((mant (car fnum)) (exp (cdr fnum)))
-	   (normalize 
-	    (cons (if (natnump mant)	; if negative, use absolute value
-		      (ash (ash mant exp) (- exp))
-		    (- (ash (ash (- mant) exp) (- exp))))
-		  exp))))))
-
-(defun fint (fnum)			; truncate and convert to integer
-  "Convert the floating point number to integer, with truncation, 
-like a C cast operator."
-  (let* ((tf (ftrunc fnum)) (tint (car tf)) (texp (cdr tf)))
-    (cond ((>= texp mantissa-bits)	; too high, return "maxint"
-	   mantissa-maxval)
-	  ((<= texp (- mantissa-bits))	; too low, return "minint"
-	   mantissa-minval)
-	  (t				; in range
-	   (ash tint texp)))))		; shift so that exponent is 0
-
-(defun float-to-string (fnum &optional sci)
-  "Convert the floating point number to a decimal string.
-Optional second argument non-nil means use scientific notation."
-  (let* ((value (fabs fnum)) (sign (< (car fnum) 0))
-	 (power 0) (result 0) (str "") 
-	 (temp 0) (pow10 _f1))
-
-    (if (f= fnum _f0)
-	"0"
-      (if (f>= value _f1)			; find largest power of 10 <= value
-	  (progn				; value >= 1, power is positive
-	    (while (f<= (setq temp (f* pow10 highest-power-of-10)) value)
-	      (setq pow10 temp
-		    power (+ power decimal-digits)))
-	    (while (f<= (setq temp (f* pow10 _f10)) value)
-	      (setq pow10 temp
-		    power (1+ power))))
-	(progn				; value < 1, power is negative
-	  (while (f> (setq temp (f/ pow10 highest-power-of-10)) value)
-	    (setq pow10 temp
-		  power (- power decimal-digits)))
-	  (while (f> pow10 value)
-	    (setq pow10 (f/ pow10 _f10)
-		  power (1- power)))))
-					  ; get value in range 100000 to 999999
-      (setq value (f* (f/ value pow10) all-decimal-digs-minval)
-	    result (ftrunc value))
-      (let (int)
-	(if (f> (f- value result) _f1/2)	; round up if remainder > 0.5
-	    (setq int (1+ (fint result)))
-	  (setq int (fint result)))
-	(setq str (int-to-string int))
-	(if (>= int 1000000)
-	    (setq power (1+ power))))
-
-      (if sci				; scientific notation
-	  (setq str (concat (substring str 0 1) "." (substring str 1)
-			    "E" (int-to-string power)))
-
-					  ; regular decimal string
-	(cond ((>= power (1- decimal-digits))
-					  ; large power, append zeroes
-	       (let ((zeroes (- power decimal-digits)))
-		 (while (natnump zeroes)
-		   (setq str (concat str "0")
-			 zeroes (1- zeroes)))))
-
-					  ; negative power, prepend decimal
-	      ((< power 0)		; point and zeroes
-	       (let ((zeroes (- (- power) 2)))
-		 (while (natnump zeroes)
-		   (setq str (concat "0" str)
-			 zeroes (1- zeroes)))
-		 (setq str (concat "0." str))))
-
-	      (t				; in range, insert decimal point
-	       (setq str (concat
-			  (substring str 0 (1+ power))
-			  "."
-			  (substring str (1+ power)))))))
-
-      (if sign				; if negative, prepend minus sign
-	  (concat "-" str)
-	str))))
-
-    
-;; string to float conversion.
-;; accepts scientific notation, but ignores anything after the first two
-;; digits of the exponent.
-(defun string-to-float (str)
-  "Convert the string to a floating point number.
-Accepts a decimal string in scientific notation,  with exponent preceded
-by either E or e.  Only the six most significant digits of the integer
-and fractional parts are used; only the first two digits of the exponent
-are used.  Negative signs preceding both the decimal number and the exponent
-are recognized."
-
-  (if (string-match floating-point-regexp str 0)
-      (let (power)
-	(f*
-	 ; calculate the mantissa
-	 (let* ((int-subst (extract-match str 2))
-		(fract-subst (extract-match str 4))
-		(digit-string (concat int-subst fract-subst))
-		(mant-sign (equal (extract-match str 1) "-"))
-		(leading-0s 0) (round-up nil))
-
-	   ; get rid of leading 0's
-	   (setq power (- (length int-subst) decimal-digits))
-	   (while (and (< leading-0s (length digit-string))
-		       (= (aref digit-string leading-0s) ?0))
-	     (setq leading-0s (1+ leading-0s)))
-	   (setq power (- power leading-0s)
-		 digit-string (substring digit-string leading-0s))
-	   
-	   ; if more than 6 digits, round off
-	   (if (> (length digit-string) decimal-digits)
-	       (setq round-up (>= (aref digit-string decimal-digits) ?5)
-		     digit-string (substring digit-string 0 decimal-digits))
-	     (setq power (+ power (- decimal-digits (length digit-string)))))
-
-	   ; round up and add minus sign, if necessary
-	   (f (* (+ (string-to-int digit-string)
-		    (if round-up 1 0))
-		 (if mant-sign -1 1))))
-	   
-	 ; calculate the exponent (power of ten)
-	 (let* ((expt-subst (extract-match str 9))
-		(expt-sign (equal (extract-match str 8) "-"))
-		(expt 0) (chunks 0) (tens 0) (exponent _f1)
-		(func 'f*))
- 
-	   (setq expt (+ (* (string-to-int
-			     (substring expt-subst 0
-					(min expt-digits (length expt-subst))))
-			    (if expt-sign -1 1))
-			 power))
-	   (if (< expt 0)		; if power of 10 negative
-	       (setq expt (- expt)	; take abs val of exponent
-		     func 'f/))		; and set up to divide, not multiply
-
-	   (setq chunks (/ expt decimal-digits)
-		 tens (% expt decimal-digits))
-	   ; divide or multiply by "chunks" of 10**6
-	   (while (> chunks 0)	
-	     (setq exponent (funcall func exponent highest-power-of-10)
-		   chunks (1- chunks)))
-	   ; divide or multiply by remaining power of ten
-	   (funcall func exponent (aref powers-of-10 tens)))))
-		  
-    _f0))				; if invalid, return 0
-
-(provide 'float)
-
-;;; float.el ends here
diff --git a/lisp/emacs-lisp/gulp.el b/lisp/emacs-lisp/gulp.el
deleted file mode 100644
index 0020f720b60..00000000000
--- a/lisp/emacs-lisp/gulp.el
+++ /dev/null
@@ -1,152 +0,0 @@
-;;; gulp.el --- Ask for updates for Lisp packages
-
-;; Copyright (C) 1996 Free Software Foundation, Inc.
-
-;; Author: Sam Shteingold <shteingd@math.ucla.edu>
-;; Maintainer: FSF
-;; Keywords: maintenance
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Search the emacs/{version}/lisp directory for *.el files, extract the
-;; name of the author or maintainer and send him e-mail requesting
-;; update.
-
-;;; Code:
-
-(defvar gulp-discard "^;+ *Maintainer: *FSF *$"
-  "*The regexp matching the packages not requiring the request for updates.")
-
-(defvar gulp-tmp-buffer "*gulp*" "The name of the temporary buffer.")
-
-(defvar gulp-max-len 2000
-  "*Distance into a Lisp source file to scan for keywords.")
-
-(defvar gulp-request-header
-  (concat
-   "This message was created automatically.
-A new version of GNU Emacs, "
-   (format "%d.%d" emacs-major-version (+ emacs-minor-version 1))
-   ", is entering the pretest state,
-and it is high time to submit the updates to the various emacs packages.
-You're listed as the maintainer of the following package(s):\n\n")
-  "*The starting text of a gulp message.")
-
-(defvar gulp-request-end
-  (concat
-   "\nIf you have any changes since the version in the previous release ("
-   (format "%d.%d" emacs-major-version emacs-minor-version)
-   "),
-please send them to me ASAP.
-
-Thanks.")
-  "*The closing text in a gulp message.")
-
-(defun gulp-send-requests (dir &optional time)
-  "Send requests for updates to the authors of Lisp packages in directory DIR.
-For each maintainer, the message consists of `gulp-request-header',
-followed by the list of packages (with modification times if the optional
-prefix argument TIME is non-nil), concluded with `gulp-request-end'.
-
-You can't edit the messages, but you can confirm whether to send each one.
-
-The list of addresses for which you decided not to send mail
-is left in the `*gulp*' buffer at the end."
-  (interactive "DRequest updates for Lisp directory: \nP")
-  (save-excursion
-    (set-buffer (get-buffer-create gulp-tmp-buffer))
-    (let ((m-p-alist (gulp-create-m-p-alist
-		      (directory-files dir nil "^[^=].*\\.el$" t)
-		      dir))
-	  ;; Temporarily inhibit undo in the *gulp* buffer.
-	  (buffer-undo-list t)
-	  mail-setup-hook msg node)
-      (while (setq node (car m-p-alist))
-	(setq msg (gulp-create-message (cdr node) time))
-	(setq mail-setup-hook
-	      '(lambda () 
-		 (mail-subject)
-		 (insert "It's time for Emacs updates again")
-		 (goto-char (point-max))
-		 (insert msg)))
-	(mail nil (car node))
-	(if (y-or-n-p "Send? ") (mail-send)
-	  (kill-this-buffer)
-	  (set-buffer gulp-tmp-buffer)
-	  (insert (format "%s\n\n" node)))
-	(setq m-p-alist (cdr m-p-alist))))
-    (set-buffer gulp-tmp-buffer)
-    (setq buffer-undo-list nil)))
-
-
-(defun gulp-create-message (rec time)
-  "Return the message string for REC, which is a list like (FILE TIME)."
-  (let (node (str gulp-request-header))
-    (while (setq node (car rec))
-      (setq str (concat str "\t" (car node)
-			(if time (concat "\tLast modified:\t" (cdr node)))
-			"\n"))
-      (setq rec (cdr rec)))
-    (concat str gulp-request-end)))
-
-
-(defun gulp-create-m-p-alist (flist dir)
-  "Create the maintainer/package alist for files in FLIST in DIR.
-That is a list of elements, each of the form (MAINTAINER PACKAGES...)."
-  (save-excursion
-    (let (mplist filen node mnt-tm mnt tm)
-      (get-buffer-create gulp-tmp-buffer)
-      (set-buffer gulp-tmp-buffer)
-      (setq buffer-undo-list t)
-      (while flist
-	(setq fl-tm (gulp-maintainer (setq filen (car flist)) dir))
-	(if (setq tm (cdr fl-tm) mnt (car fl-tm));; there is a definite maintainer
-	    (if (setq node (assoc mnt mplist));; this is not a new maintainer
-		(setq mplist (cons (cons mnt (cons (cons filen tm) (cdr node)))
-				   (delete node mplist)))
-	      (setq mplist (cons (list mnt (cons filen (cdr fl-tm))) mplist))))
-	(message "%s -- %s" filen fl-tm)
-	(setq flist (cdr flist)))
-      (erase-buffer)
-      mplist)))
-
-(defun gulp-maintainer (filenm dir)
-  "Return a list (MAINTAINER TIMESTAMP) for the package FILENM in directory DIR."
-  (save-excursion
-    (let* ((fl (concat dir filenm)) mnt
-	   (timest (format-time-string "%Y-%m-%d %a %T %Z"
-				       (elt (file-attributes fl) 5))))
-      (set-buffer gulp-tmp-buffer)
-      (erase-buffer)
-      (insert-file-contents fl nil 0 gulp-max-len)
-      (goto-char 1)
-      (if (re-search-forward gulp-discard nil t)
-	  (setq mnt nil) ;; do nothing, return nil
-	(goto-char 1)
-	(if (and (re-search-forward "^;+ *Maintainer: \\(.*\\)$" nil t)
-		 (> (length (setq mnt (match-string 1))) 0))
-	    () ;; found!
-	  (goto-char 1)
-	  (if (re-search-forward "^;+ *Author: \\(.*\\)$" nil t)
-	      (setq mnt (match-string 1))))
-	(if (= (length mnt) 0) (setq mnt nil))) ;; "^;; Author: $" --> nil
-      (cons mnt timest))))
-
-;;; gulp.el ends here
diff --git a/lisp/emacs-lisp/helper.el b/lisp/emacs-lisp/helper.el
deleted file mode 100644
index b1f3cfdbd65..00000000000
--- a/lisp/emacs-lisp/helper.el
+++ /dev/null
@@ -1,157 +0,0 @@
-;;; helper.el --- utility help package supporting help in electric modes
-
-;; Copyright (C) 1985 Free Software Foundation, Inc.
-
-;; Author: K. Shane Hartman
-;; Maintainer: FSF
-;; Keywords: help
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Code:
-
-;; hey, here's a helping hand.
-
-;; Bind this to a string for <blank> in "... Other keys <blank>".
-;; Helper-help uses this to construct help string when scrolling.
-;; Defaults to "return"
-(defvar Helper-return-blurb nil)
-
-;; Keymap implementation doesn't work too well for non-standard loops.
-;; But define it anyway for those who can use it.  Non-standard loops
-;; will probably have to use Helper-help.  You can't autoload the
-;; keymap either.
-
-
-(defvar Helper-help-map nil)
-(if Helper-help-map
-    nil
-  (setq Helper-help-map (make-keymap))
-  ;(fillarray Helper-help-map 'undefined)
-  (define-key Helper-help-map "m" 'Helper-describe-mode)
-  (define-key Helper-help-map "b" 'Helper-describe-bindings)
-  (define-key Helper-help-map "c" 'Helper-describe-key-briefly)
-  (define-key Helper-help-map "k" 'Helper-describe-key)
-  ;(define-key Helper-help-map "f" 'Helper-describe-function)
-  ;(define-key Helper-help-map "v" 'Helper-describe-variable)
-  (define-key Helper-help-map "?" 'Helper-help-options)
-  (define-key Helper-help-map (char-to-string help-char) 'Helper-help-options)
-  (fset 'Helper-help-map Helper-help-map))
-
-(defun Helper-help-scroller ()
-  (let ((blurb (or (and (boundp 'Helper-return-blurb)
-			Helper-return-blurb)
-		   "return")))
-    (save-window-excursion
-      (goto-char (window-start (selected-window)))
-      (if (get-buffer-window "*Help*")
-	  (pop-to-buffer "*Help*")
-	(switch-to-buffer "*Help*"))
-      (goto-char (point-min))
-      (let ((continue t) state)
-	(while continue
-	  (setq state (+ (* 2 (if (pos-visible-in-window-p (point-max)) 1 0))
-			 (if (pos-visible-in-window-p (point-min)) 1 0)))
-	  (message
-	    (nth state
-		 '("Space forward, Delete back. Other keys %s"
-		   "Space scrolls forward. Other keys %s"
-		   "Delete scrolls back. Other keys %s"
-		   "Type anything to %s"))
-	    blurb)
-	  (setq continue (read-char))
-	  (cond ((and (memq continue '(?\ ?\C-v)) (< state 2))
-		 (scroll-up))
-		((= continue ?\C-l)
-		 (recenter))
-		((and (= continue ?\177) (zerop (% state 2)))
-		 (scroll-down))
-		(t (setq continue nil))))))))
-
-(defun Helper-help-options ()
-  "Describe help options."
-  (interactive)
-  (message "c (key briefly), m (mode), k (key), b (bindings)")
-  ;(message "c (key briefly), m (mode), k (key), v (variable), f (function)")
-  (sit-for 4))
-
-(defun Helper-describe-key-briefly (key)
-  "Briefly describe binding of KEY."
-  (interactive "kDescribe key briefly: ")
-  (describe-key-briefly key)
-  (sit-for 4))
-
-(defun Helper-describe-key (key)
-  "Describe binding of KEY."
-  (interactive "kDescribe key: ")
-  (save-window-excursion (describe-key key))
-  (Helper-help-scroller))
-
-(defun Helper-describe-function ()
-  "Describe a function.  Name read interactively."
-  (interactive)
-  (save-window-excursion (call-interactively 'describe-function))
-  (Helper-help-scroller))
-
-(defun Helper-describe-variable ()
-  "Describe a variable.  Name read interactively."
-  (interactive)
-  (save-window-excursion (call-interactively 'describe-variable))
-  (Helper-help-scroller))
-
-(defun Helper-describe-mode ()
-  "Describe the current mode."
-  (interactive)
-  (let ((name mode-name)
-	(documentation (documentation major-mode)))
-    (save-excursion
-      (set-buffer (get-buffer-create "*Help*"))
-      (erase-buffer)
-      (insert name " Mode\n" documentation)
-      (help-mode)))
-  (Helper-help-scroller))
-
-;;;###autoload
-(defun Helper-describe-bindings ()
-  "Describe local key bindings of current mode."
-  (interactive)
-  (message "Making binding list...")
-  (save-window-excursion (describe-bindings))
-  (Helper-help-scroller))
-
-;;;###autoload
-(defun Helper-help ()
-  "Provide help for current mode."
-  (interactive)
-  (let ((continue t) c)
-    (while continue
-      (message "Help (Type ? for further options)")
-      (setq c (read-key-sequence nil))
-      (setq c (lookup-key Helper-help-map c))
-      (cond ((eq c 'Helper-help-options)
-	     (Helper-help-options))
-	    ((commandp c)
-	     (call-interactively c)
-	     (setq continue nil))
-	    (t
-	     (ding)
-	     (setq continue nil))))))
-
-(provide 'helper)
-
-;;; helper.el ends here
diff --git a/lisp/emacs-lisp/levents.el b/lisp/emacs-lisp/levents.el
deleted file mode 100644
index bc5c06c9cbc..00000000000
--- a/lisp/emacs-lisp/levents.el
+++ /dev/null
@@ -1,233 +0,0 @@
-;;; levents.el --- emulate the Lucid event data type and associated functions.
-
-;; Copyright (C) 1993 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Things we cannot emulate in Lisp:
-;; It is not possible to emulate current-mouse-event as a variable,
-;; though it is not hard to obtain the data from (this-command-keys).
-
-;; We do not have a variable unread-command-event;
-;; instead, we have the more general unread-command-events.
-
-;; Our read-key-sequence and read-char are not precisely
-;; compatible with those in Lucid Emacs, but they should work ok.
-
-;;; Code:
-
-(defun next-command-event (event)
-  (error "You must rewrite to use `read-command-event' instead of `next-command-event'"))
-
-(defun next-event (event)
-  (error "You must rewrite to use `read-event' instead of `next-event'"))
-
-(defun dispatch-event (event)
-  (error "`dispatch-event' not supported"))
-
-;; Make events of type eval, menu and timeout
-;; execute properly.
-
-(define-key global-map [menu] 'execute-eval-event)
-(define-key global-map [timeout] 'execute-eval-event)
-(define-key global-map [eval] 'execute-eval-event)
-
-(defun execute-eval-event (event)
-  (interactive "e")
-  (funcall (nth 1 event) (nth 2 event)))
-
-(put 'eval 'event-symbol-elements '(eval))
-(put 'menu 'event-symbol-elements '(eval))
-(put 'timeout 'event-symbol-elements '(eval))
-
-(defun allocate-event ()
-  "Returns an empty event structure.
-In this emulation, it returns nil."
-  nil)
-
-(defun button-press-event-p (obj)
-  "True if the argument is a mouse-button-press event object."
-  (and (consp obj) (symbolp (car obj))
-       (memq 'down (get (car obj) 'event-symbol-elements))))
-
-(defun button-release-event-p (obj)
-  "True if the argument is a mouse-button-release event object."
-  (and (consp obj) (symbolp (car obj))
-       (or (memq 'click (get (car obj) 'event-symbol-elements))
-	   (memq 'drag (get (car obj) 'event-symbol-elements)))))
-
-(defun character-to-event (ch &optional event)
-  "Converts a numeric ASCII value to an event structure, replete with
-bucky bits.  The character is the first argument, and the event to fill
-in is the second.  This function contains knowledge about what the codes
-mean -- for example, the number 9 is converted to the character Tab,
-not the distinct character Control-I.
-
-Beware that character-to-event and event-to-character are not strictly 
-inverse functions, since events contain much more information than the 
-ASCII character set can encode."
-  ch)
-
-(defun copy-event (event1 &optional event2)
-  "Make a copy of the given event object.
-In this emulation, `copy-event' just returns its argument."
-  event1)
-
-(defun deallocate-event (event)
-  "Allow the given event structure to be reused.
-In actual Lucid Emacs, you MUST NOT use this event object after
-calling this function with it.  You will lose.  It is not necessary to
-call this function, as event objects are garbage- collected like all
-other objects; however, it may be more efficient to explicitly
-deallocate events when you are sure that that is safe.
-
-This emulation does not actually deallocate or reuse events
-except via garbage collection and `cons'."
-  nil)
-
-(defun enqueue-eval-event: (function object)
-  "Add an eval event to the back of the queue.
-It will be the next event read after all pending events."
-  (setq unread-command-events
-	(nconc unread-command-events
-	       (list (list 'eval function object)))))
-
-(defun eval-event-p (obj)
-  "True if the argument is an eval or menu event object."
-  (eq (car-safe obj) 'eval))
-
-(defun event-button (event)
-  "Return the button-number of the given mouse-button-press event."
-  (let ((sym (car (get (car event) 'event-symbol-elements))))
-    (cdr (assq sym '((mouse-1 . 1) (mouse-2 . 2) (mouse-3 . 3)
-		     (mouse-4 . 4) (mouse-5 . 5))))))
-
-(defun event-function (event)
-  "Return the callback function of the given timeout, menu, or eval event."
-  (nth 1 event))
-
-(defun event-key (event)
-  "Returns the KeySym of the given key-press event.
-The value is an ASCII printing character (not upper case) or a symbol."
-  (if (symbolp event)
-      (car (get event 'event-symbol-elements))
-    (let ((base (logand event (1- (lsh 1 18)))))
-      (downcase (if (< base 32) (logior base 64) base)))))
-
-(defun event-object (event)
-  "Returns the function argument of the given timeout, menu, or eval event."
-  (nth 2 event))
-
-(defun event-point (event)
-  "Returns the character position of the given mouse-related event.
-If the event did not occur over a window, or did
-not occur over text, then this returns nil.  Otherwise, it returns an index
-into the buffer visible in the event's window."
-  (posn-point (event-end event)))
-
-(defun event-process (event)
-  "Returns the process of the given process-output event."
-  (nth 1 event))
-
-(defun event-timestamp (event)
-  "Returns the timestamp of the given event object.
-In Lucid Emacs, this works for any kind of event.
-In this emulation, it returns nil for non-mouse-related events."
-  (and (listp event)
-       (posn-timestamp (event-end event))))
-
-(defun event-to-character (event &optional lenient)
-  "Returns the closest ASCII approximation to the given event object.
-If the event isn't a keypress, this returns nil.
-If the second argument is non-nil, then this is lenient in its 
-translation; it will ignore modifier keys other than control and meta,
-and will ignore the shift modifier on those characters which have no 
-shifted ASCII equivalent (Control-Shift-A for example, will be mapped to 
-the same ASCII code as Control-A.)  If the second arg is nil, then nil 
-will be returned for events which have no direct ASCII equivalent."
-  (if (symbolp event)
-      (and lenient
-	   (cdr (assq event '((backspace . 8) (delete . 127) (tab . 9)
-			      (return . 10) (enter . 10)))))
-    ;; Our interpretation is, ASCII means anything a number can represent.
-    (if (integerp event)
-	event nil)))
-
-(defun event-window (event)
-  "Returns the window of the given mouse-related event object."
-  (posn-window (event-end event)))
-
-(defun event-x (event)
-  "Returns the X position in characters of the given mouse-related event."
-  (/ (car (posn-col-row (event-end event)))
-     (frame-char-width (window-frame (event-window event)))))
-
-(defun event-x-pixel (event)
-  "Returns the X position in pixels of the given mouse-related event."
-  (car (posn-col-row (event-end event))))
-
-(defun event-y (event)
-  "Returns the Y position in characters of the given mouse-related event."
-  (/ (cdr (posn-col-row (event-end event)))
-     (frame-char-height (window-frame (event-window event)))))
-
-(defun event-y-pixel (event)
-  "Returns the Y position in pixels of the given mouse-related event."
-  (cdr (posn-col-row (event-end event))))
-
-(defun key-press-event-p (obj)
-  "True if the argument is a keyboard event object."
-  (or (integerp obj)
-      (and (symbolp obj)
-	   (get obj 'event-symbol-elements))))
-
-(defun menu-event-p (obj)
-  "True if the argument is a menu event object."
-  (eq (car-safe obj) 'menu))
-
-(defun motion-event-p (obj)
-  "True if the argument is a mouse-motion event object."
-  (eq (car-safe obj) 'mouse-movement))
-
-(defun read-command-event ()
-  "Return the next keyboard or mouse event; execute other events.
-This is similar to the function `next-command-event' of Lucid Emacs,
-but different in that it returns the event rather than filling in
-an existing event object."
-  (let (event)
-    (while (progn
-	     (setq event (read-event))
-	     (not (or (key-press-event-p event)
-		      (button-press-event-p event)
-		      (button-release-event-p event)
-		      (menu-event-p event))))
-      (let ((type (car-safe event)))
-	(cond ((eq type 'eval)
-	       (funcall (nth 1 event) (nth 2 event)))
-	      ((eq type 'switch-frame)
-	       (select-frame (nth 1 event))))))
-    event))
-
-(defun process-event-p (obj)
-  "True if the argument is a process-output event object.
-GNU Emacs 19 does not currently generate process-output events."
-  (eq (car-safe obj) 'process))
-
-;;; levents.el ends here
diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el
deleted file mode 100644
index 8a6af05993f..00000000000
--- a/lisp/emacs-lisp/lisp-mnt.el
+++ /dev/null
@@ -1,554 +0,0 @@
-;;; lisp-mnt.el --- minor mode for Emacs Lisp maintainers
-
-;; Copyright (C) 1992, 1994 Free Software Foundation, Inc.
-
-;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
-;; Maintainer: Eric S. Raymond <esr@snark.thyrsus.com>
-;; Created: 14 Jul 1992
-;; Version: $Id: lisp-mnt.el,v 1.16 1996/02/06 21:35:20 erik Exp rms $
-;; Keywords: docs
-;; X-Bogus-Bureaucratic-Cruft: Gruad will get you if you don't watch out!
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation,  Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This minor mode adds some services to Emacs-Lisp editing mode.
-;;
-;; First, it knows about the header conventions for library packages.
-;; One entry point supports generating synopses from a library directory.
-;; Another can be used to check for missing headers in library files.
-;; 
-;; Another entry point automatically addresses bug mail to a package's
-;; maintainer or author.
-
-;; This file can be loaded by your lisp-mode-hook.  Have it (require 'lisp-mnt)
-
-;; This file is an example of the header conventions.  Note the following
-;; features:
-;; 
-;;    * Header line --- makes it possible to extract a one-line summary of
-;; the package's uses automatically for use in library synopses, KWIC
-;; indexes and the like.
-;; 
-;;    Format is three semicolons, followed by the filename, followed by
-;; three dashes, followed by the summary.  All fields space-separated.
-;; 
-;;    * Author line --- contains the name and net address of at least
-;; the principal author.
-;; 
-;;    If there are multiple authors, they should be listed on continuation
-;; lines led by ;;<TAB>, like this:
-;; 
-;; ;; Author: Ashwin Ram <Ram-Ashwin@cs.yale.edu>
-;; ;;	Dave Sill <de5@ornl.gov>
-;; ;;	David Lawrence <tale@pawl.rpi.edu>
-;; ;;	Noah Friedman <friedman@ai.mit.edu>
-;; ;;	Joe Wells <jbw@maverick.uswest.com>
-;; ;;	Dave Brennan <brennan@hal.com>
-;; ;;	Eric Raymond <esr@snark.thyrsus.com>
-;; 
-;; This field may have some special values; notably "FSF", meaning
-;; "Free Software Foundation".
-;; 
-;;    * Maintainer line --- should be a single name/address as in the Author
-;; line, or an address only, or the string "FSF".  If there is no maintainer
-;; line, the person(s) in the Author field are presumed to be it.  The example
-;; in this file is mildly bogus because the maintainer line is redundant.
-;;    The idea behind these two fields is to be able to write a Lisp function
-;; that does "send mail to the author" without having to mine the name out by
-;; hand. Please be careful about surrounding the network address with <> if
-;; there's also a name in the field.
-;; 
-;;    * Created line --- optional, gives the original creation date of the
-;; file.  For historical interest, basically.
-;; 
-;;    * Version line --- intended to give the reader a clue if they're looking
-;; at a different version of the file than the one they're accustomed to.  This
-;; may be an RCS or SCCS header.
-;; 
-;;    * Adapted-By line --- this is for FSF's internal use.  The person named
-;; in this field was the one responsible for installing and adapting the
-;; package for the distribution.  (This file doesn't have one because the
-;; author *is* one of the maintainers.)
-;; 
-;;    * Keywords line --- used by the finder code (now under construction)
-;; for finding Emacs Lisp code related to a topic.
-;;
-;;    * X-Bogus-Bureaucratic-Cruft line --- this is a joke and an example
-;; of a comment header.  Headers starting with `X-' should never be used
-;; for any real purpose; this is the way to safely add random headers
-;; without invoking the wrath of any program.
-;;
-;;    * Commentary line --- enables Lisp code to find the developer's and
-;; maintainers' explanations of the package internals.
-;; 
-;;    * Change log line --- optional, exists to terminate the commentary
-;; section and start a change-log part, if one exists.
-;; 
-;;    * Code line --- exists so Lisp can know where commentary and/or
-;; change-log sections end.
-;; 
-;;    * Footer line --- marks end-of-file so it can be distinguished from
-;; an expanded formfeed or the results of truncation.
-
-;;; Change Log:
-
-;; Tue Jul 14 23:44:17 1992	ESR
-;;	* Created.
-
-;;; Code:
-
-(require 'picture)		; provides move-to-column-force
-(require 'emacsbug)
-
-;;; Variables:
-
-(defvar lm-header-prefix "^;;*[ \t]+\\(@\(#\)\\)?[ \t]*\\([\$]\\)?"
-  "Prefix that is ignored before the tag.
-For example, you can write the 1st line synopsis string and headers like this
-in your Lisp package:
-
-   ;; @(#) package.el -- pacakge description
-   ;;
-   ;; @(#) $Maintainer:   Person Foo Bar $
-
-The @(#) construct is used by unix what(1) and
-then $identifier: doc string $ is used by GNU ident(1)")
-
-(defvar lm-comment-column 16
-  "Column used for placing formatted output.")
-
-(defvar lm-commentary-header "Commentary\\|Documentation"
-  "Regexp which matches start of documentation section.")
-
-(defvar lm-history-header "Change Log\\|History"
-  "Regexp which matches the start of code log section.")
-
-;;; Functions:
-
-;; These functions all parse the headers of the current buffer
-
-(defsubst lm-get-header-re (header &optional mode)
-  "Returns regexp for matching HEADER.
-If called with optional MODE and with value `section',
-return section regexp instead."
-  (cond ((eq mode 'section)
-	 (concat "^;;;;* " header ":[ \t]*$"))
-	(t
-	 (concat lm-header-prefix header ":[ \t]*"))))
-
-(defsubst lm-get-package-name ()
-  "Returns package name by looking at the first line."
-  (save-excursion
-    (goto-char (point-min))
-    (if (and (looking-at (concat lm-header-prefix))
-	     (progn (goto-char (match-end 0))
-		    (looking-at "\\([^\t ]+\\)")
-		    (match-end 1)))
-	(buffer-substring (match-beginning 1) (match-end 1))
-      )))
-
-(defun lm-section-mark (header &optional after)
-  "Return the buffer location of a given section start marker.
-The HEADER is the section mark string to search for.
-If AFTER is non-nil, return the location of the next line."
-  (save-excursion
-    (let ((case-fold-search t))
-      (goto-char (point-min))
-      (if (re-search-forward (lm-get-header-re header 'section) nil t)
-	  (progn
-	    (beginning-of-line)
-	    (if after (forward-line 1))
-	    (point))
-	nil))))
-
-(defsubst lm-code-mark ()
-  "Return the buffer location of the `Code' start marker."
-  (lm-section-mark "Code"))
-
-(defsubst lm-commentary-mark ()
-  "Return the buffer location of the `Commentary' start marker."
-  (lm-section-mark lm-commentary-header))
-
-(defsubst lm-history-mark ()
-  "Return the buffer location of the `History' start marker."
-  (lm-section-mark lm-history-header))
-
-(defun lm-header (header)
-  "Return the contents of the header named HEADER."
-  (goto-char (point-min))
-  (let ((case-fold-search t))
-    (if (and (re-search-forward (lm-get-header-re header) (lm-code-mark) t)
-	     ;;   RCS ident likes format "$identifier: data$"
-	     (looking-at "\\([^$\n]+\\)")
-	     (match-end 1))
-	(buffer-substring (match-beginning 1) (match-end 1))
-      nil)))
-
-(defun lm-header-multiline (header)
-  "Return the contents of the header named HEADER, with continuation lines.
-The returned value is a list of strings, one per line."
-  (save-excursion
-    (goto-char (point-min))
-    (let ((res (lm-header header)))
-      (cond
-       (res
-	(setq res (list res))
-	(forward-line 1)
-
-	(while (and (looking-at (concat lm-header-prefix "[\t ]+"))
-		    (progn
-		      (goto-char (match-end 0))
-		      (looking-at "\\(.*\\)"))
-		    (match-end 1))
-	  (setq res (cons (buffer-substring
-			   (match-beginning 1)
-			   (match-end 1))
-			  res))
-	  (forward-line 1))
-	))
-      res
-      )))
-
-;; These give us smart access to the header fields and commentary
-
-(defun lm-summary (&optional file)
-  "Return the one-line summary of file FILE, or current buffer if FILE is nil."
-  (save-excursion
-    (if file
-	(find-file file))
-    (goto-char (point-min))
-    (prog1
-      (if (and
-	   (looking-at lm-header-prefix)
-	   (progn (goto-char (match-end 0))
-		  (looking-at "[^ ]+[ \t]+--+[ \t]+\\(.*\\)")))
-	  (buffer-substring (match-beginning 1) (match-end 1)))
-      (if file
-	  (kill-buffer (current-buffer)))
-      )))
-
-(defun lm-crack-address (x)
-  "Split up an email address into full name and real email address.
-The value is a cons of the form (FULLNAME . ADDRESS)."
-  (cond ((string-match "\\(.+\\) [(<]\\(\\S-+@\\S-+\\)[>)]" x)
-	 (cons (substring x (match-beginning 1) (match-end 1))
-	       (substring x (match-beginning 2) (match-end 2))))
-	((string-match "\\(\\S-+@\\S-+\\) [(<]\\(.*\\)[>)]" x)
-	 (cons (substring x (match-beginning 2) (match-end 2))
-	       (substring x (match-beginning 1) (match-end 1))))
-	((string-match "\\S-+@\\S-+" x)
-	 (cons nil x))
-	(t
-	 (cons x nil))))
-
-(defun lm-authors (&optional file)
-  "Return the author list of file FILE, or current buffer if FILE is nil.
-Each element of the list is a cons; the car is the full name,
-the cdr is an email address."
-  (save-excursion
-    (if file
-	(find-file file))
-    (let ((authorlist (lm-header-multiline "author")))
-      (prog1
-	 (mapcar 'lm-crack-address authorlist)
-	  (if file
-	      (kill-buffer (current-buffer)))
-	))))
-
-(defun lm-maintainer (&optional file)
-  "Return the maintainer of file FILE, or current buffer if FILE is nil.
-The return value has the form (NAME . ADDRESS)."
-  (save-excursion
-    (if file
-	(find-file file))
-    (prog1
-	(let ((maint (lm-header "maintainer")))
-	  (if maint
-	      (lm-crack-address maint)
-	    (car (lm-authors))))
-      (if file
-	  (kill-buffer (current-buffer)))
-      )))
-
-(defun lm-creation-date (&optional file)
-  "Return the created date given in file FILE, or current buffer if FILE is nil."
-  (save-excursion
-    (if file
-	(find-file file))
-    (prog1
-	(lm-header "created")
-      (if file
-	  (kill-buffer (current-buffer)))
-      )))
-
-
-(defun lm-last-modified-date (&optional file)
-  "Return the modify-date given in file FILE, or current buffer if FILE is nil."
-  (save-excursion 
-    (if file
-	(find-file file))
-    (prog1
-	(if (progn
-	      (goto-char (point-min))
-	      (re-search-forward
-	       "\\$Id: [^ ]+ [^ ]+ \\([^/]+\\)/\\([^/]+\\)/\\([^ ]+\\) "
-	       (lm-code-mark) t))
-	    (format "%s %s %s"
-		    (buffer-substring (match-beginning 3) (match-end 3))
-		    (nth (string-to-int 
-			  (buffer-substring (match-beginning 2) (match-end 2)))
-			 '("" "Jan" "Feb" "Mar" "Apr" "May" "Jun"
-			   "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))
-		    (buffer-substring (match-beginning 1) (match-end 1))
-		    ))
-      (if file
-	  (kill-buffer (current-buffer)))
-      )))
-
-(defun lm-version (&optional file)
-  "Return the version listed in file FILE, or current buffer if FILE is nil.
-This can befound in an RCS or SCCS header to crack it out of."
-  (save-excursion 
-    (if file
-	(find-file file))
-    (prog1
-	(or
-	 (lm-header "version")
-	 (let ((header-max (lm-code-mark)))
-	   (goto-char (point-min))
-	   (cond
-	    ;; Look for an RCS header
-	    ((re-search-forward "\\$Id: [^ ]+ \\([^ ]+\\) " header-max t)
-	     (buffer-substring (match-beginning 1) (match-end 1)))
-
-	    ;; Look for an SCCS header
-	    ((re-search-forward 
-	      (concat
-	       (regexp-quote "@(#)")
-	       (regexp-quote (file-name-nondirectory (buffer-file-name)))
-	       "\t\\([012345679.]*\\)")
-	      header-max t)
-	     (buffer-substring (match-beginning 1) (match-end 1)))
-
-	    (t nil))))
-      (if file
-	  (kill-buffer (current-buffer)))
-      )))
-
-(defun lm-keywords (&optional file)
-  "Return the keywords given in file FILE, or current buffer if FILE is nil."
-  (save-excursion
-    (if file
-	(find-file file))
-    (prog1
-	(let ((keywords (lm-header "keywords")))
-	  (and keywords (downcase keywords)))
-      (if file
-	  (kill-buffer (current-buffer)))
-      )))
-
-(defun lm-adapted-by (&optional file)
-  "Return the adapted-by names in file FILE, or current buffer if FILE is nil.
-This is the name of the person who cleaned up this package for
-distribution."
-  (save-excursion
-    (if file
-	(find-file file))
-    (prog1
-	(lm-header "adapted-by")
-      (if file
-	  (kill-buffer (current-buffer)))
-      )))
-
-(defun lm-commentary (&optional file)
-  "Return the commentary in file FILE, or current buffer if FILE is nil.
-The value is returned as a string.  In the text, the commentary starts
-with tag `Commentary' and ends with tag `Change Log' or `History'."
-  (save-excursion
-    (if file
-	(find-file file))
-    (prog1
-	(let ((commentary	(lm-commentary-mark))
-	      (change-log	(lm-history-mark))
-	      (code		(lm-code-mark))
-	      )
-	  (cond
-	   ((and commentary change-log)
-	    (buffer-substring commentary change-log))
-	   ((and commentary code)
-	    (buffer-substring commentary code))
-	   (t
-	    nil)))
-      (if file
-	  (kill-buffer (current-buffer)))
-      )))
-
-;;; Verification and synopses
-
-(defun lm-insert-at-column (col &rest strings)
-  "Insert list of STRINGS, at column COL."
-  (if (> (current-column) col) (insert "\n"))
-  (move-to-column-force col)
-  (apply 'insert strings))
-
-(defun lm-verify (&optional file showok &optional verb)
-  "Check that the current buffer (or FILE if given) is in proper format.
-If FILE is a directory, recurse on its files and generate a report in
-a temporary buffer."
-  (interactive)
-  (let* ((verb    (or verb (interactive-p)))
-	 ret
-	 name
-	 )
-    (if verb
-	(setq ret "Ok."))		;init value
-
-    (if (and file (file-directory-p file))
-	(setq
-	 ret
-	 (progn
-	   (switch-to-buffer (get-buffer-create "*lm-verify*"))
-	   (erase-buffer)
-	   (mapcar
-	    '(lambda (f)
-	       (if (string-match ".*\\.el$" f)
-		   (let ((status (lm-verify f)))
-		     (if status
-			 (progn
-			   (insert f ":")
-			   (lm-insert-at-column lm-comment-column status "\n"))
-		       (and showok
-			    (progn
-			      (insert f ":")
-			      (lm-insert-at-column lm-comment-column "OK\n")))))))
-	    (directory-files file))
-	   ))
-      (save-excursion
-	(if file
-	    (find-file file))
-	(setq name (lm-get-package-name))
-
-	(setq
-	 ret
-	 (prog1
-	     (cond
-	      ((null name)
-	       "Can't find a package NAME")
-
-	      ((not (lm-authors))
-	       "Author: tag missing.")
-
-	      ((not (lm-maintainer))
-	       "Maintainer: tag missing.")
-
-	      ((not (lm-summary))
-	       "Can't find a one-line 'Summary' description")
-
-	      ((not (lm-keywords))
-	       "Keywords: tag missing.")
-
-	      ((not (lm-commentary-mark))
-	       "Can't find a 'Commentary' section marker.")
-
-	      ((not (lm-history-mark))
-	       "Can't find a 'History' section marker.")
-
-	      ((not (lm-code-mark))
-	       "Can't find a 'Code' section marker")
-
-	      ((progn
-		 (goto-char (point-max))
-		 (not
-		  (re-search-backward
-		   (concat "^;;;[ \t]+" name "[ \t]+ends here[ \t]*$"
-			   "\\|^;;;[ \t]+ End of file[ \t]+" name)
-		   nil t
-		   )))
-	       (format "Can't find a footer line for [%s]" name))
-	      (t
-	       ret))
-	   (if file
-	       (kill-buffer (current-buffer)))
-	  ))))
-    (if verb
-	(message ret))
-    ret
-    ))
-
-(defun lm-synopsis (&optional file showall)
-  "Generate a synopsis listing for the buffer or the given FILE if given.
-If FILE is a directory, recurse on its files and generate a report in
-a temporary buffer.  If SHOWALL is non-nil, also generate a line for files
-which do not include a recognizable synopsis."
-  (interactive
-   (list
-    (read-file-name "Synopsis for (file or dir): ")))
-
-  (if (and file (file-directory-p file))
-      (progn
-	(switch-to-buffer (get-buffer-create "*lm-verify*"))
-	(erase-buffer)
-	(mapcar
-	 '(lambda (f)
-	    (if (string-match ".*\\.el$" f)
-		(let ((syn (lm-synopsis f)))
-		  (if syn
-		      (progn
-			(insert f ":")
-			(lm-insert-at-column lm-comment-column syn "\n"))
-		    (and showall
-			 (progn
-			   (insert f ":")
-			   (lm-insert-at-column lm-comment-column "NA\n")))))))
-	 (directory-files file))
-	)
-    (save-excursion
-      (if file
-	  (find-file file))
-      (prog1
-	  (lm-summary)
-	(if file
-	    (kill-buffer (current-buffer)))
-	))))
-
-(defun lm-report-bug (topic)
-  "Report a bug in the package currently being visited to its maintainer.
-Prompts for bug subject.  Leaves you in a mail buffer."
-  (interactive "sBug Subject: ")
-  (let ((package	(lm-get-package-name))
-	(addr		(lm-maintainer))
-	(version	(lm-version)))
-    (mail nil
-	  (if addr
-	      (concat (car addr) " <" (cdr addr) ">")
-	    bug-gnu-emacs)
-	  topic)
-    (goto-char (point-max))
-    (insert "\nIn "
-	    package
-	    (if version (concat " version " version) "")
-	    "\n\n")
-    (message
-     (substitute-command-keys "Type \\[mail-send] to send bug report."))))
-
-(provide 'lisp-mnt)
-
-;;; lisp-mnt.el ends here
-
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
deleted file mode 100644
index 26eab753c38..00000000000
--- a/lisp/emacs-lisp/lisp-mode.el
+++ /dev/null
@@ -1,838 +0,0 @@
-;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands.
-
-;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: lisp, languages
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; The base major mode for editing Lisp code (used also for Emacs Lisp).
-;; This mode is documented in the Emacs manual
-
-;;; Code:
-
-(defvar lisp-mode-syntax-table nil "")
-(defvar emacs-lisp-mode-syntax-table nil "")
-(defvar lisp-mode-abbrev-table nil "")
-
-(if (not emacs-lisp-mode-syntax-table)
-    (let ((i 0))
-      (setq emacs-lisp-mode-syntax-table (make-syntax-table))
-      (while (< i ?0)
-	(modify-syntax-entry i "_   " emacs-lisp-mode-syntax-table)
-	(setq i (1+ i)))
-      (setq i (1+ ?9))
-      (while (< i ?A)
-	(modify-syntax-entry i "_   " emacs-lisp-mode-syntax-table)
-	(setq i (1+ i)))
-      (setq i (1+ ?Z))
-      (while (< i ?a)
-	(modify-syntax-entry i "_   " emacs-lisp-mode-syntax-table)
-	(setq i (1+ i)))
-      (setq i (1+ ?z))
-      (while (< i 128)
-	(modify-syntax-entry i "_   " emacs-lisp-mode-syntax-table)
-	(setq i (1+ i)))
-      (modify-syntax-entry ?  "    " emacs-lisp-mode-syntax-table)
-      (modify-syntax-entry ?\t "    " emacs-lisp-mode-syntax-table)
-      (modify-syntax-entry ?\n ">   " emacs-lisp-mode-syntax-table)
-      ;; Give CR the same syntax as newline, for selective-display.
-      (modify-syntax-entry ?\^m ">   " emacs-lisp-mode-syntax-table)
-      (modify-syntax-entry ?\; "<   " emacs-lisp-mode-syntax-table)
-      (modify-syntax-entry ?` "'   " emacs-lisp-mode-syntax-table)
-      (modify-syntax-entry ?' "'   " emacs-lisp-mode-syntax-table)
-      (modify-syntax-entry ?, "'   " emacs-lisp-mode-syntax-table)
-      ;; Used to be singlequote; changed for flonums.
-      (modify-syntax-entry ?. "_   " emacs-lisp-mode-syntax-table)
-      (modify-syntax-entry ?# "'   " emacs-lisp-mode-syntax-table)
-      (modify-syntax-entry ?\" "\"    " emacs-lisp-mode-syntax-table)
-      (modify-syntax-entry ?\\ "\\   " emacs-lisp-mode-syntax-table)
-      (modify-syntax-entry ?\( "()  " emacs-lisp-mode-syntax-table)
-      (modify-syntax-entry ?\) ")(  " emacs-lisp-mode-syntax-table)
-      (modify-syntax-entry ?\[ "(]  " emacs-lisp-mode-syntax-table)
-      (modify-syntax-entry ?\] ")[  " emacs-lisp-mode-syntax-table)))
-
-(if (not lisp-mode-syntax-table)
-    (progn (setq lisp-mode-syntax-table
-		 (copy-syntax-table emacs-lisp-mode-syntax-table))
-	   (modify-syntax-entry ?\| "\"   " lisp-mode-syntax-table)
-	   (modify-syntax-entry ?\[ "_   " lisp-mode-syntax-table)
-	   (modify-syntax-entry ?\] "_   " lisp-mode-syntax-table)))
-
-(define-abbrev-table 'lisp-mode-abbrev-table ())
-
-(defvar lisp-imenu-generic-expression
-      '(
-	(nil 
-	 "^\\s-*(def\\(un\\|subst\\|macro\\|advice\\)\\s-+\\([-A-Za-z0-9+]+\\)" 2)
-	("Variables" 
-	 "^\\s-*(def\\(var\\|const\\)\\s-+\\([-A-Za-z0-9+]+\\)" 2)
-	("Types" 
-	 "^\\s-*(def\\(type\\|struct\\|class\\|ine-condition\\)\\s-+\\([-A-Za-z0-9+]+\\)" 
-	 2))
-
-  "Imenu generic expression for Lisp mode.  See `imenu-generic-expression'.")
-
-(defun lisp-mode-variables (lisp-syntax)
-  (cond (lisp-syntax
-	  (set-syntax-table lisp-mode-syntax-table)))
-  (setq local-abbrev-table lisp-mode-abbrev-table)
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat page-delimiter "\\|$" ))
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate paragraph-start)
-  (make-local-variable 'paragraph-ignore-fill-prefix)
-  (setq paragraph-ignore-fill-prefix t)
-  (make-local-variable 'fill-paragraph-function)
-  (setq fill-paragraph-function 'lisp-fill-paragraph)
-  ;; Adaptive fill mode gets in the way of auto-fill,
-  ;; and should make no difference for explicit fill
-  ;; because lisp-fill-paragraph should do the job.
-  (make-local-variable 'adaptive-fill-mode)
-  (setq adaptive-fill-mode nil)
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'lisp-indent-line)
-  (make-local-variable 'indent-region-function)
-  (setq indent-region-function 'lisp-indent-region)
-  (make-local-variable 'parse-sexp-ignore-comments)
-  (setq parse-sexp-ignore-comments t)
-  (make-local-variable 'outline-regexp)
-  (setq outline-regexp ";;; \\|(....")
-  (make-local-variable 'comment-start)
-  (setq comment-start ";")
-  (make-local-variable 'comment-start-skip)
-  ;; Look within the line for a ; following an even number of backslashes
-  ;; after either a non-backslash or the line beginning.
-  (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
-  (make-local-variable 'comment-column)
-  (setq comment-column 40)
-  (make-local-variable 'comment-indent-function)
-  (setq comment-indent-function 'lisp-comment-indent)
-  (make-local-variable 'imenu-generic-expression)
-  (setq imenu-generic-expression lisp-imenu-generic-expression))
-
-(defvar shared-lisp-mode-map ()
-  "Keymap for commands shared by all sorts of Lisp modes.")
-
-(if shared-lisp-mode-map
-    ()
-   (setq shared-lisp-mode-map (make-sparse-keymap))
-   (define-key shared-lisp-mode-map "\e\C-q" 'indent-sexp)
-   (define-key shared-lisp-mode-map "\177" 'backward-delete-char-untabify))
-
-(defvar emacs-lisp-mode-map ()
-  "Keymap for Emacs Lisp mode.
-All commands in `shared-lisp-mode-map' are inherited by this map.")
-
-(if emacs-lisp-mode-map
-    ()
-  (let ((map (make-sparse-keymap "Emacs-Lisp")))
-    (setq emacs-lisp-mode-map
-	  (nconc (make-sparse-keymap) shared-lisp-mode-map))
-    (define-key emacs-lisp-mode-map "\e\t" 'lisp-complete-symbol)
-    (define-key emacs-lisp-mode-map "\e\C-x" 'eval-defun)
-    (define-key emacs-lisp-mode-map [menu-bar] (make-sparse-keymap))
-    (define-key emacs-lisp-mode-map [menu-bar emacs-lisp]
-      (cons "Emacs-Lisp" map))
-    (define-key map [edebug-defun]
-      '("Instrument Function for Debugging" . edebug-defun))
-    (define-key map [byte-recompile]
-      '("Byte-recompile Directory..." . byte-recompile-directory))
-    (define-key map [emacs-byte-compile-and-load]
-      '("Byte-compile And Load" . emacs-lisp-byte-compile-and-load))
-    (define-key map [byte-compile]
-      '("Byte-compile This File" . emacs-lisp-byte-compile))
-    (define-key map [separator-eval] '("--"))
-    (define-key map [eval-buffer] '("Evaluate Buffer" . eval-current-buffer))
-    (define-key map [eval-region] '("Evaluate Region" . eval-region))
-    (define-key map [eval-sexp] '("Evaluate Last S-expression" . eval-last-sexp))
-    (define-key map [separator-format] '("--"))
-    (define-key map [comment-region] '("Comment Out Region" . comment-region))
-    (define-key map [indent-region] '("Indent Region" . indent-region))
-    (define-key map [indent-line] '("Indent Line" . lisp-indent-line))
-    (put 'eval-region 'menu-enable 'mark-active)
-    (put 'comment-region 'menu-enable 'mark-active)
-    (put 'indent-region 'menu-enable 'mark-active)))
-
-(defun emacs-lisp-byte-compile ()
-  "Byte compile the file containing the current buffer."
-  (interactive)
-  (if buffer-file-name
-      (byte-compile-file buffer-file-name)
-    (error "The buffer must be saved in a file first")))
-
-(defun emacs-lisp-byte-compile-and-load ()
-  "Byte-compile the current file (if it has changed), then load compiled code."
-  (interactive)
-  (or buffer-file-name
-      (error "The buffer must be saved in a file first"))
-  (require 'bytecomp)
-  ;; Recompile if file or buffer has changed since last compilation.
-  (if (and (buffer-modified-p)
-	   (y-or-n-p (format "save buffer %s first? " (buffer-name))))
-      (save-buffer))
-  (let ((compiled-file-name (byte-compile-dest-file buffer-file-name)))
-    (if (file-newer-than-file-p compiled-file-name buffer-file-name)
-	(load-file compiled-file-name)
-      (byte-compile-file buffer-file-name t))))
-
-(defun emacs-lisp-mode ()
-  "Major mode for editing Lisp code to run in Emacs.
-Commands:
-Delete converts tabs to spaces as it moves back.
-Blank lines separate paragraphs.  Semicolons start comments.
-\\{emacs-lisp-mode-map}
-Entry to this mode calls the value of `emacs-lisp-mode-hook'
-if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map emacs-lisp-mode-map)
-  (set-syntax-table emacs-lisp-mode-syntax-table)
-  (setq major-mode 'emacs-lisp-mode)
-  (setq mode-name "Emacs-Lisp")
-  (lisp-mode-variables nil)
-  (run-hooks 'emacs-lisp-mode-hook))
-
-(defvar lisp-mode-map ()
-  "Keymap for ordinary Lisp mode.
-All commands in `shared-lisp-mode-map' are inherited by this map.")
-
-(if lisp-mode-map
-    ()
-  (setq lisp-mode-map
-	(nconc (make-sparse-keymap) shared-lisp-mode-map))
-  (define-key lisp-mode-map "\e\C-x" 'lisp-eval-defun)
-  (define-key lisp-mode-map "\C-c\C-z" 'run-lisp))
-
-(defun lisp-mode ()
-  "Major mode for editing Lisp code for Lisps other than GNU Emacs Lisp.
-Commands:
-Delete converts tabs to spaces as it moves back.
-Blank lines separate paragraphs.  Semicolons start comments.
-\\{lisp-mode-map}
-Note that `run-lisp' may be used either to start an inferior Lisp job
-or to switch back to an existing one.
-
-Entry to this mode calls the value of `lisp-mode-hook'
-if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map lisp-mode-map)
-  (setq major-mode 'lisp-mode)
-  (setq mode-name "Lisp")
-  (lisp-mode-variables t)
-  (set-syntax-table lisp-mode-syntax-table)
-  (run-hooks 'lisp-mode-hook))
-
-;; This will do unless shell.el is loaded.
-(defun lisp-eval-defun nil
-  "Send the current defun to the Lisp process made by \\[run-lisp]."
-  (interactive)
-  (error "Process lisp does not exist"))
-
-(defvar lisp-interaction-mode-map ()
-  "Keymap for Lisp Interaction moe.
-All commands in `shared-lisp-mode-map' are inherited by this map.")
-
-(if lisp-interaction-mode-map
-    ()
-  (setq lisp-interaction-mode-map
-	(nconc (make-sparse-keymap) shared-lisp-mode-map))
-  (define-key lisp-interaction-mode-map "\e\C-x" 'eval-defun)
-  (define-key lisp-interaction-mode-map "\e\t" 'lisp-complete-symbol)
-  (define-key lisp-interaction-mode-map "\n" 'eval-print-last-sexp))
-
-(defun lisp-interaction-mode ()
-  "Major mode for typing and evaluating Lisp forms.
-Like Lisp mode except that \\[eval-print-last-sexp] evals the Lisp expression
-before point, and prints its value into the buffer, advancing point.
-
-Commands:
-Delete converts tabs to spaces as it moves back.
-Paragraphs are separated only by blank lines.
-Semicolons start comments.
-\\{lisp-interaction-mode-map}
-Entry to this mode calls the value of `lisp-interaction-mode-hook'
-if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map lisp-interaction-mode-map)
-  (setq major-mode 'lisp-interaction-mode)
-  (setq mode-name "Lisp Interaction")
-  (set-syntax-table emacs-lisp-mode-syntax-table)
-  (lisp-mode-variables nil)
-  (run-hooks 'lisp-interaction-mode-hook))
-
-(defun eval-print-last-sexp ()
-  "Evaluate sexp before point; print value into current buffer."
-  (interactive)
-  (let ((standard-output (current-buffer)))
-    (terpri)
-    (eval-last-sexp t)
-    (terpri)))
-
-(defun eval-last-sexp (eval-last-sexp-arg-internal)
-  "Evaluate sexp before point; print value in minibuffer.
-With argument, print output into current buffer."
-  (interactive "P")
-  (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t))
-	(opoint (point)))
-    (prin1 (let ((stab (syntax-table)))
-	     (eval (unwind-protect
-		       (save-excursion
-			 (set-syntax-table emacs-lisp-mode-syntax-table)
-			 (forward-sexp -1)
-			 (save-restriction
-			   (narrow-to-region (point-min) opoint)
-			   (read (current-buffer))))
-		     (set-syntax-table stab)))))))
-
-(defun eval-defun (eval-defun-arg-internal)
-  "Evaluate defun that point is in or before.
-Print value in minibuffer.
-With argument, insert value in current buffer after the defun."
-  (interactive "P")
-  (let ((standard-output (if eval-defun-arg-internal (current-buffer) t))
-	(form (save-excursion
-		(end-of-defun)
-		(beginning-of-defun)
-		(read (current-buffer)))))
-    (if (and (eq (car form) 'defvar)
-	     (cdr-safe (cdr-safe form)))
-	(setq form (cons 'defconst (cdr form))))
-    (prin1 (eval form))))
-
-(defun lisp-comment-indent ()
-  (if (looking-at "\\s<\\s<\\s<")
-      (current-column)
-    (if (looking-at "\\s<\\s<")
-	(let ((tem (calculate-lisp-indent)))
-	  (if (listp tem) (car tem) tem))
-      (skip-chars-backward " \t")
-      (max (if (bolp) 0 (1+ (current-column)))
-	   comment-column))))
-
-(defvar lisp-indent-offset nil "")
-(defvar lisp-indent-function 'lisp-indent-function "")
-
-(defun lisp-indent-line (&optional whole-exp)
-  "Indent current line as Lisp code.
-With argument, indent any additional lines of the same expression
-rigidly along with this one."
-  (interactive "P")
-  (let ((indent (calculate-lisp-indent)) shift-amt beg end
-	(pos (- (point-max) (point))))
-    (beginning-of-line)
-    (setq beg (point))
-    (skip-chars-forward " \t")
-    (if (looking-at "\\s<\\s<\\s<")
-	;; Don't alter indentation of a ;;; comment line.
-	(goto-char (- (point-max) pos))
-      (if (and (looking-at "\\s<") (not (looking-at "\\s<\\s<")))
-	  ;; Single-semicolon comment lines should be indented
-	  ;; as comment lines, not as code.
-	  (progn (indent-for-comment) (forward-char -1))
-	(if (listp indent) (setq indent (car indent)))
-	(setq shift-amt (- indent (current-column)))
-	(if (zerop shift-amt)
-	    nil
-	  (delete-region beg (point))
-	  (indent-to indent)))
-      ;; If initial point was within line's indentation,
-      ;; position after the indentation.  Else stay at same point in text.
-      (if (> (- (point-max) pos) (point))
-	  (goto-char (- (point-max) pos)))
-      ;; If desired, shift remaining lines of expression the same amount.
-      (and whole-exp (not (zerop shift-amt))
-	   (save-excursion
-	     (goto-char beg)
-	     (forward-sexp 1)
-	     (setq end (point))
-	     (goto-char beg)
-	     (forward-line 1)
-	     (setq beg (point))
-	     (> end beg))
-	   (indent-code-rigidly beg end shift-amt)))))
-
-(defvar calculate-lisp-indent-last-sexp)
-
-(defun calculate-lisp-indent (&optional parse-start)
-  "Return appropriate indentation for current line as Lisp code.
-In usual case returns an integer: the column to indent to.
-Can instead return a list, whose car is the column to indent to.
-This means that following lines at the same level of indentation
-should not necessarily be indented the same way.
-The second element of the list is the buffer position
-of the start of the containing expression."
-  (save-excursion
-    (beginning-of-line)
-    (let ((indent-point (point))
-          state paren-depth
-          ;; setting this to a number inhibits calling hook
-          (desired-indent nil)
-          (retry t)
-          calculate-lisp-indent-last-sexp containing-sexp)
-      (if parse-start
-          (goto-char parse-start)
-          (beginning-of-defun))
-      ;; Find outermost containing sexp
-      (while (< (point) indent-point)
-        (setq state (parse-partial-sexp (point) indent-point 0)))
-      ;; Find innermost containing sexp
-      (while (and retry
-		  state
-                  (> (setq paren-depth (elt state 0)) 0))
-        (setq retry nil)
-        (setq calculate-lisp-indent-last-sexp (elt state 2))
-        (setq containing-sexp (elt state 1))
-        ;; Position following last unclosed open.
-        (goto-char (1+ containing-sexp))
-        ;; Is there a complete sexp since then?
-        (if (and calculate-lisp-indent-last-sexp
-		 (> calculate-lisp-indent-last-sexp (point)))
-            ;; Yes, but is there a containing sexp after that?
-            (let ((peek (parse-partial-sexp calculate-lisp-indent-last-sexp
-					    indent-point 0)))
-              (if (setq retry (car (cdr peek))) (setq state peek)))))
-      (if retry
-          nil
-        ;; Innermost containing sexp found
-        (goto-char (1+ containing-sexp))
-        (if (not calculate-lisp-indent-last-sexp)
-	    ;; indent-point immediately follows open paren.
-	    ;; Don't call hook.
-            (setq desired-indent (current-column))
-	  ;; Find the start of first element of containing sexp.
-	  (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
-	  (cond ((looking-at "\\s(")
-		 ;; First element of containing sexp is a list.
-		 ;; Indent under that list.
-		 )
-		((> (save-excursion (forward-line 1) (point))
-		    calculate-lisp-indent-last-sexp)
-		 ;; This is the first line to start within the containing sexp.
-		 ;; It's almost certainly a function call.
-		 (if (= (point) calculate-lisp-indent-last-sexp)
-		     ;; Containing sexp has nothing before this line
-		     ;; except the first element.  Indent under that element.
-		     nil
-		   ;; Skip the first element, find start of second (the first
-		   ;; argument of the function call) and indent under.
-		   (progn (forward-sexp 1)
-			  (parse-partial-sexp (point)
-					      calculate-lisp-indent-last-sexp
-					      0 t)))
-		 (backward-prefix-chars))
-		(t
-		 ;; Indent beneath first sexp on same line as
-		 ;; calculate-lisp-indent-last-sexp.  Again, it's
-		 ;; almost certainly a function call.
-		 (goto-char calculate-lisp-indent-last-sexp)
-		 (beginning-of-line)
-		 (parse-partial-sexp (point) calculate-lisp-indent-last-sexp
-				     0 t)
-		 (backward-prefix-chars)))))
-      ;; Point is at the point to indent under unless we are inside a string.
-      ;; Call indentation hook except when overridden by lisp-indent-offset
-      ;; or if the desired indentation has already been computed.
-      (let ((normal-indent (current-column)))
-        (cond ((elt state 3)
-               ;; Inside a string, don't change indentation.
-               (goto-char indent-point)
-               (skip-chars-forward " \t")
-               (current-column))
-              ((and (integerp lisp-indent-offset) containing-sexp)
-               ;; Indent by constant offset
-               (goto-char containing-sexp)
-               (+ (current-column) lisp-indent-offset))
-              (desired-indent)
-              ((and (boundp 'lisp-indent-function)
-                    lisp-indent-function
-                    (not retry))
-               (or (funcall lisp-indent-function indent-point state)
-                   normal-indent))
-              (t
-               normal-indent))))))
-
-(defun lisp-indent-function (indent-point state)
-  (let ((normal-indent (current-column)))
-    (goto-char (1+ (elt state 1)))
-    (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
-    (if (and (elt state 2)
-             (not (looking-at "\\sw\\|\\s_")))
-        ;; car of form doesn't seem to be a a symbol
-        (progn
-          (if (not (> (save-excursion (forward-line 1) (point))
-                      calculate-lisp-indent-last-sexp))
-              (progn (goto-char calculate-lisp-indent-last-sexp)
-                     (beginning-of-line)
-                     (parse-partial-sexp (point)
-					 calculate-lisp-indent-last-sexp 0 t)))
-          ;; Indent under the list or under the first sexp on the same
-          ;; line as calculate-lisp-indent-last-sexp.  Note that first
-          ;; thing on that line has to be complete sexp since we are
-          ;; inside the innermost containing sexp.
-          (backward-prefix-chars)
-          (current-column))
-      (let ((function (buffer-substring (point)
-					(progn (forward-sexp 1) (point))))
-	    method)
-	(setq method (or (get (intern-soft function) 'lisp-indent-function)
-			 (get (intern-soft function) 'lisp-indent-hook)))
-	(cond ((or (eq method 'defun)
-		   (and (null method)
-			(> (length function) 3)
-			(string-match "\\`def" function)))
-	       (lisp-indent-defform state indent-point))
-	      ((integerp method)
-	       (lisp-indent-specform method state
-				     indent-point normal-indent))
-	      (method
-		(funcall method state indent-point)))))))
-
-(defvar lisp-body-indent 2
-  "Number of columns to indent the second line of a `(def...)' form.")
-
-(defun lisp-indent-specform (count state indent-point normal-indent)
-  (let ((containing-form-start (elt state 1))
-        (i count)
-        body-indent containing-form-column)
-    ;; Move to the start of containing form, calculate indentation
-    ;; to use for non-distinguished forms (> count), and move past the
-    ;; function symbol.  lisp-indent-function guarantees that there is at
-    ;; least one word or symbol character following open paren of containing
-    ;; form.
-    (goto-char containing-form-start)
-    (setq containing-form-column (current-column))
-    (setq body-indent (+ lisp-body-indent containing-form-column))
-    (forward-char 1)
-    (forward-sexp 1)
-    ;; Now find the start of the last form.
-    (parse-partial-sexp (point) indent-point 1 t)
-    (while (and (< (point) indent-point)
-                (condition-case ()
-                    (progn
-                      (setq count (1- count))
-                      (forward-sexp 1)
-                      (parse-partial-sexp (point) indent-point 1 t))
-                  (error nil))))
-    ;; Point is sitting on first character of last (or count) sexp.
-    (if (> count 0)
-        ;; A distinguished form.  If it is the first or second form use double
-        ;; lisp-body-indent, else normal indent.  With lisp-body-indent bound
-        ;; to 2 (the default), this just happens to work the same with if as
-        ;; the older code, but it makes unwind-protect, condition-case,
-        ;; with-output-to-temp-buffer, et. al. much more tasteful.  The older,
-        ;; less hacked, behavior can be obtained by replacing below with
-        ;; (list normal-indent containing-form-start).
-        (if (<= (- i count) 1)
-            (list (+ containing-form-column (* 2 lisp-body-indent))
-                  containing-form-start)
-            (list normal-indent containing-form-start))
-      ;; A non-distinguished form.  Use body-indent if there are no
-      ;; distinguished forms and this is the first undistinguished form,
-      ;; or if this is the first undistinguished form and the preceding
-      ;; distinguished form has indentation at least as great as body-indent.
-      (if (or (and (= i 0) (= count 0))
-              (and (= count 0) (<= body-indent normal-indent)))
-          body-indent
-          normal-indent))))
-
-(defun lisp-indent-defform (state indent-point)
-  (goto-char (car (cdr state)))
-  (forward-line 1)
-  (if (> (point) (car (cdr (cdr state))))
-      (progn
-	(goto-char (car (cdr state)))
-	(+ lisp-body-indent (current-column)))))
-
-
-;; (put 'progn 'lisp-indent-function 0), say, causes progn to be indented
-;; like defun if the first form is placed on the next line, otherwise
-;; it is indented like any other form (i.e. forms line up under first).
-
-(put 'lambda 'lisp-indent-function 'defun)
-(put 'autoload 'lisp-indent-function 'defun)
-(put 'progn 'lisp-indent-function 0)
-(put 'prog1 'lisp-indent-function 1)
-(put 'prog2 'lisp-indent-function 2)
-(put 'save-excursion 'lisp-indent-function 0)
-(put 'save-window-excursion 'lisp-indent-function 0)
-(put 'save-selected-window 'lisp-indent-function 0)
-(put 'save-restriction 'lisp-indent-function 0)
-(put 'save-match-data 'lisp-indent-function 0)
-(put 'save-current-buffer 'lisp-indent-function 0)
-(put 'with-current-buffer 'lisp-indent-function 1)
-(put 'combine-after-change-calls 'lisp-indent-function 0)
-(put 'with-output-to-string 'lisp-indent-function 0)
-(put 'with-temp-file 'lisp-indent-function 1)
-(put 'with-temp-buffer 'lisp-indent-function 0)
-(put 'let 'lisp-indent-function 1)
-(put 'let* 'lisp-indent-function 1)
-(put 'while 'lisp-indent-function 1)
-(put 'if 'lisp-indent-function 2)
-(put 'catch 'lisp-indent-function 1)
-(put 'condition-case 'lisp-indent-function 2)
-(put 'unwind-protect 'lisp-indent-function 1)
-(put 'with-output-to-temp-buffer 'lisp-indent-function 1)
-(put 'eval-after-load 'lisp-indent-function 1)
-
-(defun indent-sexp (&optional endpos)
-  "Indent each line of the list starting just after point.
-If optional arg ENDPOS is given, indent each line, stopping when
-ENDPOS is encountered."
-  (interactive)
-  (let ((indent-stack (list nil))
-	(next-depth 0)
-	;; If ENDPOS is non-nil, use nil as STARTING-POINT
-	;; so that calculate-lisp-indent will find the beginning of
-	;; the defun we are in.
-	;; If ENDPOS is nil, it is safe not to scan before point
-	;; since every line we indent is more deeply nested than point is.
-	(starting-point (if endpos nil (point)))
-	(last-point (point))
-	last-depth bol outer-loop-done inner-loop-done state this-indent)
-    (or endpos
-	;; Get error now if we don't have a complete sexp after point.
-	(save-excursion (forward-sexp 1)))
-    (save-excursion
-      (setq outer-loop-done nil)
-      (while (if endpos (< (point) endpos)
-	       (not outer-loop-done))
-	(setq last-depth next-depth
-	      inner-loop-done nil)
-	;; Parse this line so we can learn the state
-	;; to indent the next line.
-	;; This inner loop goes through only once
-	;; unless a line ends inside a string.
-	(while (and (not inner-loop-done)
-		    (not (setq outer-loop-done (eobp))))
-	  (setq state (parse-partial-sexp (point) (progn (end-of-line) (point))
-					  nil nil state))
-	  (setq next-depth (car state))
-	  ;; If the line contains a comment other than the sort
-	  ;; that is indented like code,
-	  ;; indent it now with indent-for-comment.
-	  ;; Comments indented like code are right already.
-	  ;; In any case clear the in-comment flag in the state
-	  ;; because parse-partial-sexp never sees the newlines.
-	  (if (car (nthcdr 4 state))
-	      (progn (indent-for-comment)
-		     (end-of-line)
-		     (setcar (nthcdr 4 state) nil)))
-	  ;; If this line ends inside a string,
-	  ;; go straight to next line, remaining within the inner loop,
-	  ;; and turn off the \-flag.
-	  (if (car (nthcdr 3 state))
-	      (progn
-		(forward-line 1)
-		(setcar (nthcdr 5 state) nil))
-	    (setq inner-loop-done t)))
-	(and endpos
-	     (<= next-depth 0)
-	     (progn
-	       (setq indent-stack (append indent-stack
-					  (make-list (- next-depth) nil))
-		     last-depth (- last-depth next-depth)
-		     next-depth 0)))
-	(or outer-loop-done endpos
-	    (setq outer-loop-done (<= next-depth 0)))
-	(if outer-loop-done
-	    (forward-line 1)
-	  (while (> last-depth next-depth)
-	    (setq indent-stack (cdr indent-stack)
-		  last-depth (1- last-depth)))
-	  (while (< last-depth next-depth)
-	    (setq indent-stack (cons nil indent-stack)
-		  last-depth (1+ last-depth)))
-	  ;; Now go to the next line and indent it according
-	  ;; to what we learned from parsing the previous one.
-	  (forward-line 1)
-	  (setq bol (point))
-	  (skip-chars-forward " \t")
-	  ;; But not if the line is blank, or just a comment
-	  ;; (except for double-semi comments; indent them as usual).
-	  (if (or (eobp) (looking-at "\\s<\\|\n"))
-	      nil
-	    (if (and (car indent-stack)
-		     (>= (car indent-stack) 0))
-		(setq this-indent (car indent-stack))
-	      (let ((val (calculate-lisp-indent
-			  (if (car indent-stack) (- (car indent-stack))
-			    starting-point))))
-		(if (integerp val)
-		    (setcar indent-stack
-			    (setq this-indent val))
-		  (setcar indent-stack (- (car (cdr val))))
-		  (setq this-indent (car val)))))
-	    (if (/= (current-column) this-indent)
-		(progn (delete-region bol (point))
-		       (indent-to this-indent)))))
-	(or outer-loop-done
-	    (setq outer-loop-done (= (point) last-point))
-	    (setq last-point (point)))))))
-
-;; Indent every line whose first char is between START and END inclusive.
-(defun lisp-indent-region (start end)
-  (save-excursion
-    (let ((endmark (copy-marker end)))
-      (goto-char start)
-      (and (bolp) (not (eolp))
-	   (lisp-indent-line))
-      (indent-sexp endmark)
-      (set-marker endmark nil))))
-
-;;;; Lisp paragraph filling commands.
-
-(defun lisp-fill-paragraph (&optional justify)
-  "Like \\[fill-paragraph], but handle Emacs Lisp comments.
-If any of the current line is a comment, fill the comment or the
-paragraph of it that point is in, preserving the comment's indentation
-and initial semicolons."
-  (interactive "P")
-  (let (
-	;; Non-nil if the current line contains a comment.
-	has-comment
-
-	;; Non-nil if the current line contains code and a comment.
-	has-code-and-comment
-
-	;; If has-comment, the appropriate fill-prefix for the comment.
-	comment-fill-prefix
-	)
-
-    ;; Figure out what kind of comment we are looking at.
-    (save-excursion
-      (beginning-of-line)
-      (cond
-
-       ;; A line with nothing but a comment on it?
-       ((looking-at "[ \t]*;[; \t]*")
-	(setq has-comment t
-	      comment-fill-prefix (buffer-substring (match-beginning 0)
-						    (match-end 0))))
-
-       ;; A line with some code, followed by a comment?  Remember that the
-       ;; semi which starts the comment shouldn't be part of a string or
-       ;; character.
-       ((condition-case nil
-	    (save-restriction
-	      (narrow-to-region (point-min)
-				(save-excursion (end-of-line) (point)))
-	      (while (not (looking-at ";\\|$"))
-		(skip-chars-forward "^;\n\"\\\\?")
-		(cond
-		 ((eq (char-after (point)) ?\\) (forward-char 2))
-		 ((memq (char-after (point)) '(?\" ??)) (forward-sexp 1))))
-	      (looking-at ";+[\t ]*"))
-	  (error nil))
-	(setq has-comment t has-code-and-comment t)
-	(setq comment-fill-prefix
-	      (concat (make-string (/ (current-column) 8) ?\t)
-		      (make-string (% (current-column) 8) ?\ )
-		      (buffer-substring (match-beginning 0) (match-end 0)))))))
-
-    (if (not has-comment)
-	(fill-paragraph justify)
-
-      ;; Narrow to include only the comment, and then fill the region.
-      (save-excursion
-	(save-restriction
-	  (beginning-of-line)
-	  (narrow-to-region
-	   ;; Find the first line we should include in the region to fill.
-	   (save-excursion
-	     (while (and (zerop (forward-line -1))
-			 (looking-at "^[ \t]*;")))
-	     ;; We may have gone too far.  Go forward again.
-	     (or (looking-at ".*;")
-		 (forward-line 1))
-	     (point))
-	   ;; Find the beginning of the first line past the region to fill.
-	   (save-excursion
-	     (while (progn (forward-line 1)
-			   (looking-at "^[ \t]*;")))
-	     (point)))
-
-	  ;; Lines with only semicolons on them can be paragraph boundaries.
-	  (let* ((paragraph-start (concat paragraph-start "\\|[ \t;]*$"))
-		 (paragraph-separate (concat paragraph-start "\\|[ \t;]*$"))
-		 (paragraph-ignore-fill-prefix nil)
-		 (fill-prefix comment-fill-prefix)
-		 (after-line (if has-code-and-comment
-				 (save-excursion
-				   (forward-line 1) (point))))
-		 (end (progn
-			(forward-paragraph)
-			(or (bolp) (newline 1))
-			(point)))
-		 ;; If this comment starts on a line with code,
-		 ;; include that like in the filling.
-		 (beg (progn (backward-paragraph)
-			     (if (eq (point) after-line)
-				 (forward-line -1))
-			     (point))))
-	    (fill-region-as-paragraph beg end
-				      justify nil
-				      (save-excursion
-					(goto-char beg)
-					(if (looking-at fill-prefix)
-					    nil
-					  (re-search-forward comment-start-skip)
-					  (point))))))))
-    t))
-
-(defun indent-code-rigidly (start end arg &optional nochange-regexp)
-  "Indent all lines of code, starting in the region, sideways by ARG columns.
-Does not affect lines starting inside comments or strings, assuming that
-the start of the region is not inside them.
-
-Called from a program, takes args START, END, COLUMNS and NOCHANGE-REGEXP.
-The last is a regexp which, if matched at the beginning of a line,
-means don't indent that line."
-  (interactive "r\np")
-  (let (state)
-    (save-excursion
-      (goto-char end)
-      (setq end (point-marker))
-      (goto-char start)
-      (or (bolp)
-	  (setq state (parse-partial-sexp (point)
-					  (progn
-					    (forward-line 1) (point))
-					  nil nil state)))
-      (while (< (point) end)
-	(or (car (nthcdr 3 state))
-	    (and nochange-regexp
-		 (looking-at nochange-regexp))
-	    ;; If line does not start in string, indent it
-	    (let ((indent (current-indentation)))
-	      (delete-region (point) (progn (skip-chars-forward " \t") (point)))
-	      (or (eolp)
-		  (indent-to (max 0 (+ indent arg)) 0))))
-	(setq state (parse-partial-sexp (point)
-					(progn
-					  (forward-line 1) (point))
-					nil nil state))))))
-
-(provide 'lisp-mode)
-
-;;; lisp-mode.el ends here
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
deleted file mode 100644
index 767c96e620b..00000000000
--- a/lisp/emacs-lisp/lisp.el
+++ /dev/null
@@ -1,316 +0,0 @@
-;;; lisp.el --- Lisp editing commands for Emacs
-
-;; Copyright (C) 1985, 1986, 1994 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: lisp, languages
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Lisp editing commands to go with Lisp major mode.
-
-;;; Code:
-
-;; Note that this variable is used by non-lisp modes too.
-(defvar defun-prompt-regexp nil
-  "*Non-nil => regexp to ignore, before the character that starts a defun.
-This is only necessary if the opening paren or brace is not in column 0.
-See `beginning-of-defun'.")
-(make-variable-buffer-local 'defun-prompt-regexp)
-
-(defvar parens-require-spaces t
-  "Non-nil => `insert-parentheses' should insert whitespace as needed.")
-
-(defun forward-sexp (&optional arg)
-  "Move forward across one balanced expression (sexp).
-With argument, do it that many times.  Negative arg -N means
-move backward across N balanced expressions."
-  (interactive "p")
-  (or arg (setq arg 1))
-  (goto-char (or (scan-sexps (point) arg) (buffer-end arg)))
-  (if (< arg 0) (backward-prefix-chars)))
-
-(defun backward-sexp (&optional arg)
-  "Move backward across one balanced expression (sexp).
-With argument, do it that many times.  Negative arg -N means
-move forward across N balanced expressions."
-  (interactive "p")
-  (or arg (setq arg 1))
-  (forward-sexp (- arg)))
-
-(defun mark-sexp (arg)
-  "Set mark ARG sexps from point.
-The place mark goes is the same place \\[forward-sexp] would
-move to with the same argument."
-  (interactive "p")
-  (push-mark
-    (save-excursion
-      (forward-sexp arg)
-      (point))
-    nil t))
-
-(defun forward-list (&optional arg)
-  "Move forward across one balanced group of parentheses.
-With argument, do it that many times.
-Negative arg -N means move backward across N groups of parentheses."
-  (interactive "p")
-  (or arg (setq arg 1))
-  (goto-char (or (scan-lists (point) arg 0) (buffer-end arg))))
-
-(defun backward-list (&optional arg)
-  "Move backward across one balanced group of parentheses.
-With argument, do it that many times.
-Negative arg -N means move forward across N groups of parentheses."
-  (interactive "p")
-  (or arg (setq arg 1))
-  (forward-list (- arg)))
-
-(defun down-list (arg)
-  "Move forward down one level of parentheses.
-With argument, do this that many times.
-A negative argument means move backward but still go down a level.
-In Lisp programs, an argument is required."
-  (interactive "p")
-  (let ((inc (if (> arg 0) 1 -1)))
-    (while (/= arg 0)
-      (goto-char (or (scan-lists (point) inc -1) (buffer-end arg)))
-      (setq arg (- arg inc)))))
-
-(defun backward-up-list (arg)
-  "Move backward out of one level of parentheses.
-With argument, do this that many times.
-A negative argument means move forward but still to a less deep spot.
-In Lisp programs, an argument is required."
-  (interactive "p")
-  (up-list (- arg)))
-
-(defun up-list (arg) 
-  "Move forward out of one level of parentheses.
-With argument, do this that many times.
-A negative argument means move backward but still to a less deep spot.
-In Lisp programs, an argument is required."
-  (interactive "p")
-  (let ((inc (if (> arg 0) 1 -1)))
-    (while (/= arg 0)
-      (goto-char (or (scan-lists (point) inc 1) (buffer-end arg)))
-      (setq arg (- arg inc)))))
-
-(defun kill-sexp (arg)
-  "Kill the sexp (balanced expression) following the cursor.
-With argument, kill that many sexps after the cursor.
-Negative arg -N means kill N sexps before the cursor."
-  (interactive "p")
-  (let ((opoint (point)))
-    (forward-sexp arg)
-    (kill-region opoint (point))))
-
-(defun backward-kill-sexp (arg)
-  "Kill the sexp (balanced expression) preceding the cursor.
-With argument, kill that many sexps before the cursor.
-Negative arg -N means kill N sexps after the cursor."
-  (interactive "p")
-  (kill-sexp (- arg)))
-
-(defun beginning-of-defun (&optional arg)
-  "Move backward to the beginning of a defun.
-With argument, do it that many times.  Negative arg -N
-means move forward to Nth following beginning of defun.
-Returns t unless search stops due to beginning or end of buffer.
-
-Normally a defun starts when there is an char with open-parenthesis
-syntax at the beginning of a line.  If `defun-prompt-regexp' is
-non-nil, then a string which matches that regexp may precede the
-open-parenthesis, and point ends up at the beginning of the line."
-  (interactive "p")
-  (and (beginning-of-defun-raw arg)
-       (progn (beginning-of-line) t)))
-
-(defun beginning-of-defun-raw (&optional arg)
-  "Move point to the character that starts a defun.
-This is identical to beginning-of-defun, except that point does not move
-to the beginning of the line when `defun-prompt-regexp' is non-nil."
-  (interactive "p")
-  (and arg (< arg 0) (not (eobp)) (forward-char 1))
-  (and (re-search-backward (if defun-prompt-regexp
-			       (concat "^\\s(\\|"
-				       "\\(" defun-prompt-regexp "\\)\\s(")
-			     "^\\s(")
-			   nil 'move (or arg 1))
-       (progn (goto-char (1- (match-end 0)))) t))
-
-(defun buffer-end (arg)
-  (if (> arg 0) (point-max) (point-min)))
-
-(defun end-of-defun (&optional arg)
-  "Move forward to next end of defun.  With argument, do it that many times.
-Negative argument -N means move back to Nth preceding end of defun.
-
-An end of a defun occurs right after the close-parenthesis that matches
-the open-parenthesis that starts a defun; see `beginning-of-defun'."
-  (interactive "p")
-  (if (or (null arg) (= arg 0)) (setq arg 1))
-  (let ((first t))
-    (while (and (> arg 0) (< (point) (point-max)))
-      (let ((pos (point)) npos)
-	(while (progn
-		(if (and first
-			 (progn
-			  (end-of-line 1)
-			  (beginning-of-defun-raw 1)))
-		    nil
-		  (or (bobp) (forward-char -1))
-		  (beginning-of-defun-raw -1))
-		(setq first nil)
-		(forward-list 1)
-		(skip-chars-forward " \t")
-		(if (looking-at "\\s<\\|\n")
-		    (forward-line 1))
-		(<= (point) pos))))
-      (setq arg (1- arg)))
-    (while (< arg 0)
-      (let ((pos (point)))
-	(beginning-of-defun-raw 1)
-	(forward-sexp 1)
-	(forward-line 1)
-	(if (>= (point) pos)
-	    (if (beginning-of-defun-raw 2)
-		(progn
-		  (forward-list 1)
-		  (skip-chars-forward " \t")
-		  (if (looking-at "\\s<\\|\n")
-		      (forward-line 1)))
-	      (goto-char (point-min)))))
-      (setq arg (1+ arg)))))
-
-(defun mark-defun ()
-  "Put mark at end of this defun, point at beginning.
-The defun marked is the one that contains point or follows point."
-  (interactive)
-  (push-mark (point))
-  (end-of-defun)
-  (push-mark (point) nil t)
-  (beginning-of-defun)
-  (re-search-backward "^\n" (- (point) 1) t))
-
-(defun narrow-to-defun (&optional arg)
-  "Make text outside current defun invisible.
-The defun visible is the one that contains point or follows point."
-  (interactive)
-  (save-excursion
-    (widen)
-    (end-of-defun)
-    (let ((end (point)))
-      (beginning-of-defun)
-      (narrow-to-region (point) end))))
-
-(defun insert-parentheses (arg)
-  "Enclose following ARG sexps in parentheses.  Leave point after open-paren.
-A negative ARG encloses the preceding ARG sexps instead.
-No argument is equivalent to zero: just insert `()' and leave point between.
-If `parens-require-spaces' is non-nil, this command also inserts a space
-before and after, depending on the surrounding characters."
-  (interactive "P")
-  (if arg (setq arg (prefix-numeric-value arg))
-    (setq arg 0))
-  (cond ((> arg 0) (skip-chars-forward " \t"))
-	((< arg 0) (forward-sexp arg) (setq arg (- arg))))
-  (and parens-require-spaces
-       (not (bobp))
-       (memq (char-syntax (preceding-char)) '(?w ?_ ?\) ))
-       (insert " "))
-  (insert ?\()
-  (save-excursion
-    (or (eq arg 0) (forward-sexp arg))
-    (insert ?\))
-    (and parens-require-spaces
-	 (not (eobp))
-	 (memq (char-syntax (following-char)) '(?w ?_ ?\( ))
-	 (insert " "))))
-
-(defun move-past-close-and-reindent ()
-  "Move past next `)', delete indentation before it, then indent after it."
-  (interactive)
-  (up-list 1)
-  (forward-char -1)
-  (while (save-excursion		; this is my contribution
-	   (let ((before-paren (point)))
-	     (back-to-indentation)
-	     (= (point) before-paren)))
-    (delete-indentation))
-  (forward-char 1)
-  (newline-and-indent))
-
-(defun lisp-complete-symbol ()
-  "Perform completion on Lisp symbol preceding point.
-Compare that symbol against the known Lisp symbols.
-
-The context determines which symbols are considered.
-If the symbol starts just after an open-parenthesis, only symbols
-with function definitions are considered.  Otherwise, all symbols with
-function definitions, values or properties are considered."
-  (interactive)
-  (let* ((end (point))
-	 (buffer-syntax (syntax-table))
-	 (beg (unwind-protect
-		  (save-excursion
-		    (set-syntax-table emacs-lisp-mode-syntax-table)
-		    (backward-sexp 1)
-		    (while (= (char-syntax (following-char)) ?\')
-		      (forward-char 1))
-		    (point))
-		(set-syntax-table buffer-syntax)))
-	 (pattern (buffer-substring beg end))
-	 (predicate
-	  (if (eq (char-after (1- beg)) ?\()
-	      'fboundp
-	    (function (lambda (sym)
-			(or (boundp sym) (fboundp sym)
-			    (symbol-plist sym))))))
-	 (completion (try-completion pattern obarray predicate)))
-    (cond ((eq completion t))
-	  ((null completion)
-	   (message "Can't find completion for \"%s\"" pattern)
-	   (ding))
-	  ((not (string= pattern completion))
-	   (delete-region beg end)
-	   (insert completion))
-	  (t
-	   (message "Making completion list...")
-	   (let ((list (all-completions pattern obarray predicate))
-		 (completion-fixup-function
-		  (function (lambda () (if (save-excursion
-					     (goto-char (max (point-min) (- (point) 4)))
-					     (looking-at " <f>"))
-					   (forward-char -4))))))
-	     (setq list (sort list 'string<))
-	     (or (eq predicate 'fboundp)
-		 (let (new)
-		   (while list
-		     (setq new (cons (if (fboundp (intern (car list)))
-					 (list (car list) " <f>")
-				       (car list))
-				     new))
-		     (setq list (cdr list)))
-		   (setq list (nreverse new))))
-	     (with-output-to-temp-buffer "*Completions*"
-	       (display-completion-list list)))
-	   (message "Making completion list...%s" "done")))))
-
-;;; lisp.el ends here
diff --git a/lisp/emacs-lisp/lmenu.el b/lisp/emacs-lisp/lmenu.el
deleted file mode 100644
index a878f6ca206..00000000000
--- a/lisp/emacs-lisp/lmenu.el
+++ /dev/null
@@ -1,506 +0,0 @@
-;;; lmenu.el --- emulate Lucid's menubar support
-
-;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
-
-;; Keywords: emulations
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Code:
-
-
-;; First, emulate the Lucid menubar support in GNU Emacs 19.
-
-;; Arrange to use current-menubar to set up part of the menu bar.
-
-(defvar current-menubar)
-
-(setq recompute-lucid-menubar 'recompute-lucid-menubar)
-(defun recompute-lucid-menubar ()
-  (define-key lucid-menubar-map [menu-bar]
-    (condition-case nil
-	(make-lucid-menu-keymap "menu-bar" current-menubar)
-      (error (message "Invalid data in current-menubar moved to lucid-failing-menubar")
-	     (sit-for 1)
-	     (setq lucid-failing-menubar current-menubar
-		   current-menubar nil))))
-  (setq lucid-menu-bar-dirty-flag nil))
-
-(defvar lucid-menubar-map (make-sparse-keymap))
-(or (assq 'current-menubar minor-mode-map-alist)
-    (setq minor-mode-map-alist
-	  (cons (cons 'current-menubar lucid-menubar-map)
-		minor-mode-map-alist)))
-
-(defun set-menubar-dirty-flag ()
-  (force-mode-line-update)
-  (setq lucid-menu-bar-dirty-flag t))
-
-(defvar add-menu-item-count 0)
-
-;; This is a variable whose value is always nil.
-(defvar make-lucid-menu-keymap-disable nil)
-
-;; Return a menu keymap corresponding to a Lucid-style menu list
-;; MENU-ITEMS, and with name MENU-NAME.
-(defun make-lucid-menu-keymap (menu-name menu-items)
-  (let ((menu (make-sparse-keymap menu-name)))
-    ;; Process items in reverse order,
-    ;; since the define-key loop reverses them again.
-    (setq menu-items (reverse menu-items))
-    (while menu-items
-      (let ((item (car menu-items))
-	    command name callback)
-	(cond ((stringp item)
-	       (setq command nil)
-	       (setq name (if (string-match "^-+$" item) "" item)))
-	      ((consp item)
-	       (setq command (make-lucid-menu-keymap (car item) (cdr item)))
-	       (setq name (car item)))
-	      ((vectorp item)
-	       (setq command (make-symbol (format "menu-function-%d"
-						  add-menu-item-count))
-		     add-menu-item-count (1+ add-menu-item-count)
-		     name (aref item 0)
-		     callback (aref item 1))
-	       (if (symbolp callback)
-		   (fset command callback)
-		 (fset command (list 'lambda () '(interactive) callback)))
-	       (put command 'menu-alias t)
-	       (let ((i 2))
-		 (while (< i (length item))
-		   (cond
-		    ((eq (aref item i) ':active)
-		     (put command 'menu-enable
-			  (or (aref item (1+ i))
-			      'make-lucid-menu-keymap-disable))
-		     (setq i (+ 2 i)))
-		    ((eq (aref item i) ':suffix)
-		     ;; unimplemented
-		     (setq i (+ 2 i)))
-		    ((eq (aref item i) ':keys)
-		     ;; unimplemented
-		     (setq i (+ 2 i)))
-		    ((eq (aref item i) ':style)
-		     ;; unimplemented
-		     (setq i (+ 2 i)))
-		    ((eq (aref item i) ':selected)
-		     ;; unimplemented
-		     (setq i (+ 2 i)))
-		    ((and (symbolp (aref item i))
-			  (= ?: (string-to-char (symbol-name (aref item i)))))
-		     (error "Unrecognized menu item keyword: %S"
-			    (aref item i)))
-		    ((= i 2)
-		     ;; old-style format: active-p &optional suffix
-		     (put command 'menu-enable
-			  (or (aref item i) 'make-lucid-menu-keymap-disable))
-		     ;; suffix is unimplemented
-		     (setq i (length item)))
-		    (t
-		     (error "Unexpected menu item value: %S"
-			    (aref item i))))))))
-	(if (null command)
-	    ;; Handle inactive strings specially--allow any number
-	    ;; of identical ones.
-	    (setcdr menu (cons (list nil name) (cdr menu)))
-	  (if name
-	      (define-key menu (vector (intern name)) (cons name command)))))
-      (setq menu-items (cdr menu-items)))
-    menu))
-
-(defun popup-menu (menu-desc)
-  "Pop up the given menu.
-A menu is a list of menu items, strings, and submenus.
-
-The first element of a menu must be a string, which is the name of the
-menu.  This is the string that will be displayed in the parent menu, if
-any.  For toplevel menus, it is ignored.  This string is not displayed
-in the menu itself.
-
-A menu item is a vector containing:
-
- - the name of the menu item (a string);
- - the `callback' of that item;
- - a list of keywords with associated values:
-   - :active active-p	a form specifying whether this item is selectable;
-   - :suffix suffix	a string to be appended to the name as an `argument'
-			to the command, like `Kill Buffer NAME';
-   - :keys command-keys	a string, suitable for `substitute-command-keys',
-			to specify the keyboard equivalent of a command
-			when the callback is a form (this is not necessary
-			when the callback is a symbol, as the keyboard
-			equivalent is computed automatically in that case);
-   - :style style	a symbol: nil for a normal menu item, `toggle' for
-			a toggle button (a single option that can be turned
-			on or off), or `radio' for a radio button (one of a
-			group of mutually exclusive options);
-   - :selected form	for `toggle' or `radio' style, a form that specifies
-			whether the button will be in the selected state.
-
-Alternately, the vector may contain exactly 3 or 4 elements, with the third
-element specifying `active-p' and the fourth specifying `suffix'.
-
-If the `callback' of a menu item is a symbol, then it must name a command.
-It will be invoked with `call-interactively'.  If it is a list, then it is
-evaluated with `eval'.
-
-If an element of a menu is a string, then that string will be presented in
-the menu as unselectable text.
-
-If an element of a menu is a string consisting solely of hyphens, then that
-item will be presented as a solid horizontal line.
-
-If an element of a menu is a list, it is treated as a submenu.  The name of
-that submenu (the first element in the list) will be used as the name of the
-item representing this menu on the parent.
-
-The syntax, more precisely:
-
-   form		:=  <something to pass to `eval'>
-   command	:=  <a symbol or string, to pass to `call-interactively'>
-   callback 	:=  command | form
-   active-p	:=  <t or nil, whether this thing is selectable>
-   text		:=  <string, non selectable>
-   name		:=  <string>
-   suffix	:=  <string>
-   command-keys	:=  <string>
-   object-style	:=  'nil' | 'toggle' | 'radio'
-   keyword	:=  ':active' active-p
-		 |  ':suffix' suffix
-		 |  ':keys' command-keys
-		 |  ':style' object-style
-		 |  ':selected' form
-   menu-item	:=  '['  name callback active-p [ suffix ]  ']'
-		 |  '['  name callback [ keyword ]+  ']'
-   menu		:=  '(' name [ menu-item | menu | text ]+ ')'"
-  (let ((menu (make-lucid-menu-keymap (car menu-desc) (cdr menu-desc)))
-	(pos (mouse-pixel-position))
-	answer cmd)
-    (while (and menu
-		(setq answer (x-popup-menu (list (list (nth 1 pos)
-						       (nthcdr 2 pos))
-						 (car pos))
-					   menu)))
-      (setq cmd (lookup-key menu (apply 'vector answer)))
-      (setq menu nil)
-      (and cmd
-	   (if (keymapp cmd)
-	       (setq menu cmd)
-	     (call-interactively cmd))))))
-
-(defun popup-dialog-box (data)
-  "Pop up a dialog box.
-A dialog box description is a list.
-
- - The first element of the list is a string to display in the dialog box.
- - The rest of the elements are descriptions of the dialog box's buttons.
-   Each one is a vector of three elements:
-   - The first element is the text of the button.
-   - The second element is the `callback'.
-   - The third element is t or nil, whether this button is selectable.
-
-If the `callback' of a button is a symbol, then it must name a command.
-It will be invoked with `call-interactively'.  If it is a list, then it is
-evaluated with `eval'.
-
-One (and only one) of the buttons may be `nil'.  This marker means that all
-following buttons should be flushright instead of flushleft.
-
-The syntax, more precisely:
-
-   form		:=  <something to pass to `eval'>
-   command	:=  <a symbol or string, to pass to `call-interactively'>
-   callback 	:=  command | form
-   active-p	:=  <t, nil, or a form to evaluate to decide whether this
-		    button should be selectable>
-   name		:=  <string>
-   partition	:=  'nil'
-   button	:=  '['  name callback active-p ']'
-   dialog	:=  '(' name [ button ]+ [ partition [ button ]+ ] ')'"
-  (let ((name (car data))
-	(tail (cdr data))
-	converted
-	choice meaning)
-    (while tail
-      (if (null (car tail))
-	  (setq converted (cons nil converted))
-	(let ((item (aref (car tail) 0))
-	      (callback (aref (car tail) 1))
-	      (enable (aref (car tail) 2)))
-	  (setq converted
-		(cons (if enable (cons item callback) item)
-		      converted))))
-      (setq tail (cdr tail)))
-    (setq choice (x-popup-dialog t (cons name (nreverse converted))))
-    (if choice
-	(if (symbolp choice)
-	    (call-interactively choice)
-	  (eval choice)))))
-
-;; This is empty because the usual elements of the menu bar
-;; are provided by menu-bar.el instead.
-;; It would not make sense to duplicate them here.
-(defconst default-menubar nil)
-
-(defun set-menubar (menubar)
-  "Set the default menubar to be menubar."
-  (setq-default current-menubar (copy-sequence menubar))
-  (set-menubar-dirty-flag))
-
-(defun set-buffer-menubar (menubar)
-  "Set the buffer-local menubar to be menubar."
-  (make-local-variable 'current-menubar)
-  (setq current-menubar (copy-sequence menubar))
-  (set-menubar-dirty-flag))
-
-
-;;; menu manipulation functions
-
-(defun find-menu-item (menubar item-path-list &optional parent)
-  "Searches MENUBAR for item given by ITEM-PATH-LIST.
-Returns (ITEM . PARENT), where PARENT is the immediate parent of
- the item found.
-Signals an error if the item is not found."
-  (or parent (setq item-path-list (mapcar 'downcase item-path-list)))
-  (if (not (consp menubar))
-      nil
-    (let ((rest menubar)
-	  result)
-      (while rest
-	(if (and (car rest)
-		 (equal (car item-path-list)
-			(downcase (if (vectorp (car rest))
-				      (aref (car rest) 0)
-				    (if (stringp (car rest))
-					(car rest)
-				      (car (car rest)))))))
-	    (setq result (car rest) rest nil)
-	  (setq rest (cdr rest))))
-      (if (cdr item-path-list)
-	  (if (consp result)
-	      (find-menu-item (cdr result) (cdr item-path-list) result)
-	    (if result
-		(signal 'error (list "not a submenu" result))
-	      (signal 'error (list "no such submenu" (car item-path-list)))))
-	(cons result parent)))))
-
-
-(defun disable-menu-item (path)
-  "Make the named menu item be unselectable.
-PATH is a list of strings which identify the position of the menu item in
-the menu hierarchy.  (\"File\" \"Save\") means the menu item called \"Save\"
-under the toplevel \"File\" menu.  (\"Menu\" \"Foo\" \"Item\") means the
-menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
-  (let* ((menubar current-menubar)
-	 (pair (find-menu-item menubar path))
-	 (item (car pair))
-	 (menu (cdr pair)))
-    (or item
-	(signal 'error (list (if menu "No such menu item" "No such menu")
-			     path)))
-    (if (consp item) (error "can't disable menus, only menu items"))
-    (aset item 2 nil)
-    (set-menubar-dirty-flag)
-    item))
-
-
-(defun enable-menu-item (path)
-  "Make the named menu item be selectable.
-PATH is a list of strings which identify the position of the menu item in
-the menu hierarchy.  (\"File\" \"Save\") means the menu item called \"Save\"
-under the toplevel \"File\" menu.  (\"Menu\" \"Foo\" \"Item\") means the
-menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
-  (let* ((menubar current-menubar)
-	 (pair (find-menu-item menubar path))
-	 (item (car pair))
-	 (menu (cdr pair)))
-    (or item
-	(signal 'error (list (if menu "No such menu item" "No such menu")
-			     path)))
-    (if (consp item) (error "%S is a menu, not a menu item" path))
-    (aset item 2 t)
-    (set-menubar-dirty-flag)
-    item))
-
-
-(defun add-menu-item-1 (item-p menu-path item-name item-data enabled-p before)
-  (if before (setq before (downcase before)))
-  (let* ((menubar current-menubar)
-	 (menu (condition-case ()
-		   (car (find-menu-item menubar menu-path))
-		 (error nil)))
-	 (item (if (listp menu)
-		   (car (find-menu-item (cdr menu) (list item-name)))
-		 (signal 'error (list "not a submenu" menu-path)))))
-    (or menu
-	(let ((rest menu-path)
-	      (so-far menubar))
-	  (while rest
-;;;	    (setq menu (car (find-menu-item (cdr so-far) (list (car rest)))))
-	    (setq menu
-		  (if (eq so-far menubar)
-		      (car (find-menu-item so-far (list (car rest))))
-		    (car (find-menu-item (cdr so-far) (list (car rest))))))
-	    (or menu
-		(let ((rest2 so-far))
-		  (or rest2
-		      (error "Trying to modify a menu that doesn't exist"))
-		  (while (and (cdr rest2) (car (cdr rest2)))
-		    (setq rest2 (cdr rest2)))
-		  (setcdr rest2
-			  (nconc (list (setq menu (list (car rest))))
-				 (cdr rest2)))))
-	    (setq so-far menu)
-	    (setq rest (cdr rest)))))
-    (or menu (setq menu menubar))
-    (if item
-	nil	; it's already there
-      (if item-p
-	  (setq item (vector item-name item-data enabled-p))
-	(setq item (cons item-name item-data)))
-      ;; if BEFORE is specified, try to add it there.
-      (if before
-	  (setq before (car (find-menu-item menu (list before)))))
-      (let ((rest menu)
-	    (added-before nil))
-	(while rest
-	  (if (eq before (car (cdr rest)))
-	      (progn
-		(setcdr rest (cons item (cdr rest)))
-		(setq rest nil added-before t))
-	    (setq rest (cdr rest))))
-	(if (not added-before)
-	    ;; adding before the first item on the menubar itself is harder
-	    (if (and (eq menu menubar) (eq before (car menu)))
-		(setq menu (cons item menu)
-		      current-menubar menu)
-	      ;; otherwise, add the item to the end.
-	      (nconc menu (list item))))))
-    (if item-p
-	(progn
-	  (aset item 1 item-data)
-	  (aset item 2 (not (null enabled-p))))
-      (setcar item item-name)
-      (setcdr item item-data))
-    (set-menubar-dirty-flag)
-    item))
-
-(defun add-menu-item (menu-path item-name function enabled-p &optional before)
-  "Add a menu item to some menu, creating the menu first if necessary.
-If the named item exists already, it is changed.
-MENU-PATH identifies the menu under which the new menu item should be inserted.
- It is a list of strings; for example, (\"File\") names the top-level \"File\"
- menu.  (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
-ITEM-NAME is the string naming the menu item to be added.
-FUNCTION is the command to invoke when this menu item is selected.
- If it is a symbol, then it is invoked with `call-interactively', in the same
- way that functions bound to keys are invoked.  If it is a list, then the
- list is simply evaluated.
-ENABLED-P controls whether the item is selectable or not.
-BEFORE, if provided, is the name of a menu item before which this item should
- be added, if this item is not on the menu already.  If the item is already
- present, it will not be moved."
-  (or menu-path (error "must specify a menu path"))
-  (or item-name (error "must specify an item name"))
-  (add-menu-item-1 t menu-path item-name function enabled-p before))
-
-
-(defun delete-menu-item (path)
-  "Remove the named menu item from the menu hierarchy.
-PATH is a list of strings which identify the position of the menu item in
-the menu hierarchy.  (\"File\" \"Save\") means the menu item called \"Save\"
-under the toplevel \"File\" menu.  (\"Menu\" \"Foo\" \"Item\") means the
-menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
-  (let* ((menubar current-menubar)
-	 (pair (find-menu-item menubar path))
-	 (item (car pair))
-	 (menu (or (cdr pair) menubar)))
-    (if (not item)
-	nil
-      ;; the menubar is the only special case, because other menus begin
-      ;; with their name.
-      (if (eq menu current-menubar)
-	  (setq current-menubar (delq item menu))
-	(delq item menu))
-      (set-menubar-dirty-flag)
-      item)))
-
-
-(defun relabel-menu-item (path new-name)
-  "Change the string of the specified menu item.
-PATH is a list of strings which identify the position of the menu item in
-the menu hierarchy.  (\"File\" \"Save\") means the menu item called \"Save\"
-under the toplevel \"File\" menu.  (\"Menu\" \"Foo\" \"Item\") means the
-menu item called \"Item\" under the \"Foo\" submenu of \"Menu\".
-NEW-NAME is the string that the menu item will be printed as from now on."
-  (or (stringp new-name)
-      (setq new-name (signal 'wrong-type-argument (list 'stringp new-name))))
-  (let* ((menubar current-menubar)
-	 (pair (find-menu-item menubar path))
-	 (item (car pair))
-	 (menu (cdr pair)))
-    (or item
-	(signal 'error (list (if menu "No such menu item" "No such menu")
-			     path)))
-    (if (and (consp item)
-	     (stringp (car item)))
-	(setcar item new-name)
-      (aset item 0 new-name))
-    (set-menubar-dirty-flag)
-    item))
-
-(defun add-menu (menu-path menu-name menu-items &optional before)
-  "Add a menu to the menubar or one of its submenus.
-If the named menu exists already, it is changed.
-MENU-PATH identifies the menu under which the new menu should be inserted.
- It is a list of strings; for example, (\"File\") names the top-level \"File\"
- menu.  (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
- If MENU-PATH is nil, then the menu will be added to the menubar itself.
-MENU-NAME is the string naming the menu to be added.
-MENU-ITEMS is a list of menu item descriptions.
- Each menu item should be a vector of three elements:
-   - a string, the name of the menu item;
-   - a symbol naming a command, or a form to evaluate;
-   - and a form whose value determines whether this item is selectable.
-BEFORE, if provided, is the name of a menu before which this menu should
- be added, if this menu is not on its parent already.  If the menu is already
- present, it will not be moved."
-  (or menu-name (error "must specify a menu name"))
-  (or menu-items (error "must specify some menu items"))
-  (add-menu-item-1 nil menu-path menu-name menu-items t before))
-
-
-
-(defvar put-buffer-names-in-file-menu t)
-
-
-;; Don't unconditionally enable menu bars; leave that up to the user.
-;;(let ((frames (frame-list)))
-;;  (while frames
-;;    (modify-frame-parameters (car frames) '((menu-bar-lines . 1)))
-;;    (setq frames (cdr frames))))
-;;(or (assq 'menu-bar-lines default-frame-alist)
-;;    (setq default-frame-alist
-;;	  (cons '(menu-bar-lines . 1) default-frame-alist)))
-
-(set-menubar default-menubar)
-
-(provide 'lmenu)
-
-;;; lmenu.el ends here
diff --git a/lisp/emacs-lisp/lselect.el b/lisp/emacs-lisp/lselect.el
deleted file mode 100644
index c6c64a909f8..00000000000
--- a/lisp/emacs-lisp/lselect.el
+++ /dev/null
@@ -1,230 +0,0 @@
-;;; lselect.el --- Lucid interface to X Selections
-
-;; Copyright (C) 1990, 1993 Free Software Foundation, Inc.
-
-;; Keywords: emulations
-
-;; This won't completely work until we support or emulate Lucid-style extents.
-;; Based on Lucid's selection code.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Code:
-
-;;; The selection code requires us to use certain symbols whose names are
-;;; all upper-case; this may seem tasteless, but it makes there be a 1:1
-;;; correspondence between these symbols and X Atoms (which are upcased.)
-
-(defalias 'x-get-cutbuffer 'x-get-cut-buffer)
-(defalias 'x-store-cutbuffer 'x-set-cut-buffer)
-
-(or (find-face 'primary-selection)
-    (make-face 'primary-selection))
-
-(or (find-face 'secondary-selection)
-    (make-face 'secondary-selection))
-
-(defun x-get-secondary-selection ()
-  "Return text selected from some X window."
-  (x-get-selection-internal 'SECONDARY 'STRING))
-
-(defvar primary-selection-extent nil
-  "The extent of the primary selection; don't use this.")
-
-(defvar secondary-selection-extent nil
-  "The extent of the secondary selection; don't use this.")
-
-
-(defun x-select-make-extent-for-selection (selection previous-extent face)
-  ;; Given a selection, this makes an extent in the buffer which holds that
-  ;; selection, for highlighting purposes.  If the selection isn't associated
-  ;; with a buffer, this does nothing.
-  (let ((buffer nil)
-	(valid (and (extentp previous-extent)
-		    (extent-buffer previous-extent)
-		    (buffer-name (extent-buffer previous-extent))))
-	start end)
-    (cond ((stringp selection)
-	   ;; if we're selecting a string, lose the previous extent used
-	   ;; to highlight the selection.
-	   (setq valid nil))
-	  ((consp selection)
-	   (setq start (min (car selection) (cdr selection))
-		 end (max (car selection) (cdr selection))
-		 valid (and valid
-			    (eq (marker-buffer (car selection))
-				(extent-buffer previous-extent)))
-		 buffer (marker-buffer (car selection))))
-	  ((extentp selection)
-	   (setq start (extent-start-position selection)
-		 end (extent-end-position selection)
-		 valid (and valid
-			    (eq (extent-buffer selection)
-				(extent-buffer previous-extent)))
-		 buffer (extent-buffer selection)))
-	  )
-    (if (and (not valid)
-	     (extentp previous-extent)
-	     (extent-buffer previous-extent)
-	     (buffer-name (extent-buffer previous-extent)))
-	(delete-extent previous-extent))
-    (if (not buffer)
-	;; string case
-	nil
-      ;; normal case
-      (if valid
-	  (set-extent-endpoints previous-extent start end)
-	(setq previous-extent (make-extent start end buffer))
-	;; use same priority as mouse-highlighting so that conflicts between
-	;; the selection extent and a mouse-highlighted extent are resolved
-	;; by the usual size-and-endpoint-comparison method.
-	(set-extent-priority previous-extent mouse-highlight-priority)
-	(set-extent-face previous-extent face)))))
-
-
-(defun x-own-selection (selection &optional type)
-  "Make a primary X Selection of the given argument.  
-The argument may be a string, a cons of two markers, or an extent.  
-In the latter cases the selection is considered to be the text 
-between the markers, or the between extents endpoints."
-  (interactive (if (not current-prefix-arg)
-		   (list (read-string "Store text for pasting: "))
-		 (list (cons ;; these need not be ordered.
-			(copy-marker (point-marker))
-			(copy-marker (mark-marker))))))
-  (or type (setq type 'PRIMARY))
-  (x-set-selection selection type)
-  (cond ((eq type 'PRIMARY)
-	 (setq primary-selection-extent
-	       (x-select-make-extent-for-selection
-		selection primary-selection-extent 'primary-selection)))
-	((eq type 'SECONDARY)
-	 (setq secondary-selection-extent
-	       (x-select-make-extent-for-selection
-		selection secondary-selection-extent 'secondary-selection))))
-  selection)
-
-
-(defun x-own-secondary-selection (selection &optional type)
-  "Make a secondary X Selection of the given argument.  The argument may be a 
-string or a cons of two markers (in which case the selection is considered to
-be the text between those markers.)"
-  (interactive (if (not current-prefix-arg)
-		   (list (read-string "Store text for pasting: "))
-		 (list (cons ;; these need not be ordered.
-			(copy-marker (point-marker))
-			(copy-marker (mark-marker))))))
-  (x-own-selection selection 'SECONDARY))
-
-
-(defun x-own-clipboard (string)
-  "Paste the given string to the X Clipboard."
-  (x-own-selection string 'CLIPBOARD))
-
-
-(defun x-disown-selection (&optional secondary-p)
-  "Assuming we own the selection, disown it.  With an argument, discard the
-secondary selection instead of the primary selection."
-  (x-disown-selection-internal (if secondary-p 'SECONDARY 'PRIMARY)))
-
-(defun x-dehilight-selection (selection)
-  "for use as a value of x-lost-selection-hooks."
-  (cond ((eq selection 'PRIMARY)
-	 (if primary-selection-extent
-	     (let ((inhibit-quit t))
-	       (delete-extent primary-selection-extent)
-	       (setq primary-selection-extent nil)))
-	 (if zmacs-regions (zmacs-deactivate-region)))
-	((eq selection 'SECONDARY)
-	 (if secondary-selection-extent
-	     (let ((inhibit-quit t))
-	       (delete-extent secondary-selection-extent)
-	       (setq secondary-selection-extent nil)))))
-  nil)
-
-(setq x-lost-selection-hooks 'x-dehilight-selection)
-
-(defun x-notice-selection-requests (selection type successful)
-  "for possible use as the value of x-sent-selection-hooks."
-  (if (not successful)
-      (message "Selection request failed to convert %s to %s"
-	       selection type)
-    (message "Sent selection %s as %s" selection type)))
-
-(defun x-notice-selection-failures (selection type successful)
-  "for possible use as the value of x-sent-selection-hooks."
-  (or successful
-      (message "Selection request failed to convert %s to %s"
-	       selection type)))
-
-;(setq x-sent-selection-hooks 'x-notice-selection-requests)
-;(setq x-sent-selection-hooks 'x-notice-selection-failures)
-
-
-;;; Random utility functions
-
-(defun x-kill-primary-selection ()
-  "If there is a selection, delete the text it covers, and copy it to 
-both the kill ring and the Clipboard."
-  (interactive)
-  (or (x-selection-owner-p) (error "emacs does not own the primary selection"))
-  (setq last-command nil)
-  (or primary-selection-extent
-      (error "the primary selection is not an extent?"))
-  (save-excursion
-    (set-buffer (extent-buffer primary-selection-extent))
-    (kill-region (extent-start-position primary-selection-extent)
-		 (extent-end-position primary-selection-extent)))
-  (x-disown-selection nil))
-
-(defun x-delete-primary-selection ()
-  "If there is a selection, delete the text it covers *without* copying it to
-the kill ring or the Clipboard."
-  (interactive)
-  (or (x-selection-owner-p) (error "emacs does not own the primary selection"))
-  (setq last-command nil)
-  (or primary-selection-extent
-      (error "the primary selection is not an extent?"))
-  (save-excursion
-    (set-buffer (extent-buffer primary-selection-extent))
-    (delete-region (extent-start-position primary-selection-extent)
-		   (extent-end-position primary-selection-extent)))
-  (x-disown-selection nil))
-
-(defun x-copy-primary-selection ()
-  "If there is a selection, copy it to both the kill ring and the Clipboard."
-  (interactive)
-  (setq last-command nil)
-  (or (x-selection-owner-p) (error "emacs does not own the primary selection"))
-  (or primary-selection-extent
-      (error "the primary selection is not an extent?"))
-  (save-excursion
-    (set-buffer (extent-buffer primary-selection-extent))
-    (copy-region-as-kill (extent-start-position primary-selection-extent)
-			 (extent-end-position primary-selection-extent))))
-
-(defun x-yank-clipboard-selection ()
-  "If someone owns a Clipboard selection, insert it at point."
-  (interactive)
-  (setq last-command nil)
-  (let ((clip (x-get-clipboard)))
-    (or clip (error "there is no clipboard selection"))
-    (push-mark)
-    (insert clip)))
-
-;;; lselect.el ends here.
diff --git a/lisp/emacs-lisp/lucid.el b/lisp/emacs-lisp/lucid.el
deleted file mode 100644
index 5c609137ffe..00000000000
--- a/lisp/emacs-lisp/lucid.el
+++ /dev/null
@@ -1,223 +0,0 @@
-;;; lucid.el --- Emulate some Lucid Emacs functions.
-
-;; Copyright (C) 1993, 1995 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Code:
-
-(defun copy-tree (tree)
-  (if (consp tree)
-      (cons (copy-tree (car tree))
-	    (copy-tree (cdr tree)))
-    (if (vectorp tree)
-	(let* ((new (copy-sequence tree))
-	       (i (1- (length new))))
-	  (while (>= i 0)
-	    (aset new i (copy-tree (aref new i)))
-	    (setq i (1- i)))
-	  new)
-      tree)))
-
-(defalias 'current-time-seconds 'current-time)
-
-(defun remprop (symbol prop)
-  (let ((plist (symbol-plist symbol)))
-    (while (eq (car plist) prop)
-      (setplist symbol (setq plist (cdr (cdr plist)))))
-    (while plist
-      (if (eq (nth 2 plist) prop)
-	  (setcdr (cdr plist) (nthcdr 4 plist)))
-      (setq plist (cdr (cdr plist))))))
-
-(defun map-keymap (function keymap &optional sort-first)
-  "Call FUNCTION for every binding in KEYMAP.
-This includes bindings inherited from a parent keymap.
-FUNCTION receives two arguments each time it is called:
-the character (more generally, the event type) that is bound,
-and the binding it has.
-
-Note that passing the event type directly to `define-key' does not work
-in Emacs 19.  We do not emulate that particular feature of Lucid Emacs.
-If your code does that, modify it to make a vector containing the event
-type that you get.  That will work in both versions of Emacs."
-  (if sort-first
-      (let (list)
-	(map-keymap (function (lambda (a b)
-				(setq list (cons (cons a b) list))))
-		    keymap)
-	(setq list (sort list
-			 (function (lambda (a b)
-				     (setq a (car a) b (car b))
-				     (if (integerp a)
-					 (if (integerp b) (< a b)
-					   t)
-				       (if (integerp b) t
-					 (string< a b)))))))
-	(while list
-	  (funcall function (car (car list)) (cdr (car list)))
-	  (setq list (cdr list))))
-    (while (consp keymap)
-      (if (consp (car keymap))
-	  (funcall function (car (car keymap)) (cdr (car keymap)))
-	(if (vectorp (car keymap))
-	    (let ((i (1- (length (car keymap))))
-		  (vector (car keymap)))
-	      (while (>= i 0)
-		(funcall function i (aref vector i))
-		(setq i (1- i))))))
-      (setq keymap (cdr keymap)))))
-
-(defun read-number (prompt &optional integers-only)
-  "Read a number from the minibuffer.
-Keep reentering the minibuffer until we get suitable input.
-If optional argument INTEGERS-ONLY is non-nil, insist on an integer."
-  (interactive)
-  (let (success
-	(number nil)
-	(predicate (if integers-only 'integerp 'numberp)))
-    (while (not success)
-      (let ((input-string (read-string prompt)))
-	(condition-case ()
-	    (setq number (read input-string))
-	  (error))
-	(if (funcall predicate number)
-	    (setq success t)
-	  (let ((cursor-in-echo-area t))
-	    (message "Please type %s"
-		     (if integers-only "an integer" "a number"))
-	    (sit-for 1)))))
-    number))
-
-(defun real-path-name (name &optional default)
-  (file-truename (expand-file-name name default)))
-
-;; It's not clear what to return if the mouse is not in FRAME.
-(defun read-mouse-position (frame)
-  (let ((pos (mouse-position)))
-    (if (eq (car pos) frame)
-	(cdr pos))))
-
-(defun switch-to-other-buffer (arg)
-  "Switch to the previous buffer.
-With a numeric arg N, switch to the Nth most recent buffer.
-With an arg of 0, buries the current buffer at the
-bottom of the buffer stack."
-  (interactive "p")
-  (if (eq arg 0)
-      (bury-buffer (current-buffer)))
-  (switch-to-buffer
-   (if (<= arg 1) (other-buffer (current-buffer))
-     (nth arg
-	  (apply 'nconc
-		 (mapcar
-		  (lambda (buf)
-		    (if (= ?\  (string-to-char (buffer-name buf)))
-			nil
-		      (list buf)))
-		  (buffer-list)))))))
-
-(defalias 'find-face 'internal-find-face)
-(defalias 'get-face 'internal-get-face)
-(defalias 'try-face-font 'internal-try-face-font)
-
-(defalias 'exec-to-string 'shell-command-to-string)
-
-(defun make-extent (beg end &optional buffer)
-  (make-overlay beg end buffer))
-
-(defun set-extent-property (extent prop value)
-  (if (eq prop 'duplicable)
-      (cond ((and value (not (overlay-get extent prop)))
-	     ;; If becoming duplicable, copy all overlayprops to text props.
-	     (add-text-properties (overlay-start extent)
-				  (overlay-end extent)
-				  (overlay-properties extent)
-				  (overlay-buffer extent)))
-	    ;; If becoming no longer duplicable, remove these text props.
-	    ((and (not value) (overlay-get extent prop))
-	     (remove-text-properties (overlay-start extent)
-				     (overlay-end extent)
-				     (overlay-properties extent)
-				     (overlay-buffer extent))))
-    ;; If extent is already duplicable, put this property
-    ;; on the text as well as on the overlay.
-    (if (overlay-get extent 'duplicable)
-	(put-text-property  (overlay-start extent)
-			    (overlay-end extent)
-			    prop value (overlay-buffer extent))))
-  (overlay-put extent prop value))
-
-(defun set-extent-face (extent face)
-  (set-extent-property extent 'face face))
-
-(defun delete-extent (extent)
-  (set-extent-property extent 'duplicable nil)
-  (delete-overlay extent))
-
-;; Support the Lucid names with `screen' instead of `frame'.
-
-(defalias 'current-screen-configuration 'current-frame-configuration)
-(defalias 'delete-screen 'delete-frame)
-(defalias 'find-file-new-screen 'find-file-other-frame)
-(defalias 'find-file-read-only-new-screen 'find-file-read-only-other-frame)
-(defalias 'find-tag-new-screen 'find-tag-other-frame)
-;;(defalias 'focus-screen 'focus-frame)
-(defalias 'iconify-screen 'iconify-frame)
-(defalias 'mail-new-screen 'mail-other-frame)
-(defalias 'make-screen-invisible 'make-frame-invisible)
-(defalias 'make-screen-visible 'make-frame-visible)
-;; (defalias 'minibuffer-screen-list 'minibuffer-frame-list)
-(defalias 'modify-screen-parameters 'modify-frame-parameters)
-(defalias 'next-screen 'next-frame)
-;; (defalias 'next-multiscreen-window 'next-multiframe-window)
-;; (defalias 'previous-multiscreen-window 'previous-multiframe-window)
-;; (defalias 'redirect-screen-focus 'redirect-frame-focus)
-(defalias 'redraw-screen 'redraw-frame)
-;; (defalias 'screen-char-height 'frame-char-height)
-;; (defalias 'screen-char-width 'frame-char-width)
-;; (defalias 'screen-configuration-to-register 'frame-configuration-to-register)
-;; (defalias 'screen-focus 'frame-focus)
-(defalias 'screen-list 'frame-list)
-;; (defalias 'screen-live-p 'frame-live-p)
-(defalias 'screen-parameters 'frame-parameters)
-(defalias 'screen-pixel-height 'frame-pixel-height)
-(defalias 'screen-pixel-width 'frame-pixel-width)
-(defalias 'screen-root-window 'frame-root-window)
-(defalias 'screen-selected-window 'frame-selected-window)
-(defalias 'lower-screen 'lower-frame)
-(defalias 'raise-screen 'raise-frame)
-(defalias 'screen-visible-p 'frame-visible-p)
-(defalias 'screenp 'framep)
-(defalias 'select-screen 'select-frame)
-(defalias 'selected-screen 'selected-frame)
-;; (defalias 'set-screen-configuration 'set-frame-configuration)
-;; (defalias 'set-screen-height 'set-frame-height)
-(defalias 'set-screen-position 'set-frame-position)
-(defalias 'set-screen-size 'set-frame-size)
-;; (defalias 'set-screen-width 'set-frame-width)
-(defalias 'switch-to-buffer-new-screen 'switch-to-buffer-other-frame)
-;; (defalias 'unfocus-screen 'unfocus-frame)
-(defalias 'visible-screen-list 'visible-frame-list)
-(defalias 'window-screen 'window-frame)
-(defalias 'x-create-screen 'x-create-frame)
-(defalias 'x-new-screen 'make-frame)
-
-(provide 'lucid)
-
-;;; end of lucid.el
diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el
deleted file mode 100644
index 013ce8402d3..00000000000
--- a/lisp/emacs-lisp/pp.el
+++ /dev/null
@@ -1,181 +0,0 @@
-;;; pp.el --- pretty printer for Emacs Lisp
-
-;; Copyright (C) 1989, 1993 Free Software Foundation, Inc.
-
-;; Author: Randal Schwartz <merlyn@stonehenge.com>
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Code:
-
-(defvar pp-escape-newlines t 
-  "*Value of print-escape-newlines used by pp-* functions.")
-
-(defun pp-to-string (object)
-  "Return a string containing the pretty-printed representation of OBJECT,
-any Lisp object.  Quoting characters are used when needed to make output
-that `read' can handle, whenever this is possible."
-  (save-excursion
-    (set-buffer (generate-new-buffer " pp-to-string"))
-    (unwind-protect
-	(progn
-	  (lisp-mode-variables t)
-	  (let ((print-escape-newlines pp-escape-newlines))
-	    (prin1 object (current-buffer)))
-	  (goto-char (point-min))
-	  (while (not (eobp))
-	    ;; (message "%06d" (- (point-max) (point)))
-	    (cond
-	     ((looking-at "\\s(\\|#\\s(")
-	      (while (looking-at "\\s(\\|#\\s(")
-		(forward-char 1)))
-	     ((and (looking-at "\\(quote[ \t]+\\)\\([^.)]\\)")
-		   (> (match-beginning 1) 1)
-		   (= ?\( (char-after (1- (match-beginning 1))))
-		   ;; Make sure this is a two-element list.
-		   (save-excursion
-		     (goto-char (match-beginning 2))
-		     (forward-sexp)
-		     ;; (looking-at "[ \t]*\)")
-		     ;; Avoid mucking with match-data; does this test work?
-		     (char-equal ?\) (char-after (point)))))
-	      ;; -1 gets the paren preceding the quote as well.
-	      (delete-region (1- (match-beginning 1)) (match-end 1))
-	      (insert "'")
-	      (forward-sexp 1)
-	      (if (looking-at "[ \t]*\)")
-		  (delete-region (match-beginning 0) (match-end 0))
-		(error "Malformed quote"))
-	      (backward-sexp 1))	      
-	     ((condition-case err-var
-		  (prog1 t (down-list 1))
-		(error nil))
-	      (backward-char 1)
-	      (skip-chars-backward " \t")
-	      (delete-region
-	       (point)
-	       (progn (skip-chars-forward " \t") (point)))
-	      (if (not (char-equal ?' (char-after (1- (point)))))
-		  (insert ?\n)))
-	     ((condition-case err-var
-		  (prog1 t (up-list 1))
-		(error nil))
-	      (while (looking-at "\\s)")
-		(forward-char 1))
-	      (skip-chars-backward " \t")
-	      (delete-region
-	       (point)
-	       (progn (skip-chars-forward " \t") (point)))
-	      (if (not (char-equal ?' (char-after (1- (point)))))
-		  (insert ?\n)))
-	     (t (goto-char (point-max)))))
-	  (goto-char (point-min))
-	  (indent-sexp)
-	  (buffer-string))
-      (kill-buffer (current-buffer)))))
-
-;;;###autoload
-(defun pp (object &optional stream)
-  "Output the pretty-printed representation of OBJECT, any Lisp object.
-Quoting characters are printed when needed to make output that `read'
-can handle, whenever this is possible.
-Output stream is STREAM, or value of `standard-output' (which see)."
-  (princ (pp-to-string object) (or stream standard-output)))
-
-;;;###autoload
-(defun pp-eval-expression (expression)
-  "Evaluate EXPRESSION and pretty-print value into a new display buffer.
-If the pretty-printed value fits on one line, the message line is used
-instead.  Value is also consed on to front of variable  values 's
-value."
-  (interactive "xPp-eval: ")
-  (setq values (cons (eval expression) values))
-  (let* ((old-show-function temp-buffer-show-function)
-	 ;; Use this function to display the buffer.
-	 ;; This function either decides not to display it at all
-	 ;; or displays it in the usual way.
-	 (temp-buffer-show-function
-	  (function
-	   (lambda (buf)
-	     (save-excursion
-	       (set-buffer buf)
-	       (goto-char (point-min))
-	       (end-of-line 1)
-	       (if (or (< (1+ (point)) (point-max))
-		       (>= (- (point) (point-min)) (frame-width)))
-		   (let ((temp-buffer-show-function old-show-function)
-			 (old-selected (selected-window))
-			 (window (display-buffer buf)))
-		     (goto-char (point-min)) ; expected by some hooks ...
-		     (make-frame-visible (window-frame window))
-		     (unwind-protect
-			 (progn
-			   (select-window window)
-			   (run-hooks 'temp-buffer-show-hook))
-		       (select-window old-selected)))
-		 (message "%s" (buffer-substring (point-min) (point)))
-		 ))))))
-    (with-output-to-temp-buffer "*Pp Eval Output*"
-      (pp (car values)))
-    (save-excursion
-      (set-buffer "*Pp Eval Output*")
-      (emacs-lisp-mode)
-      (make-local-variable 'font-lock-verbose)
-      (setq font-lock-verbose nil))))
-
-;;;###autoload
-(defun pp-eval-last-sexp (arg)
-  "Run `pp-eval-expression' on sexp before point (which see).
-With argument, pretty-print output into current buffer.
-Ignores leading comment characters."
-  (interactive "P")
-  (let ((stab (syntax-table)) (pt (point)) start exp)
-    (set-syntax-table emacs-lisp-mode-syntax-table)
-    (save-excursion
-      (forward-sexp -1)
-      ;; If first line is commented, ignore all leading comments:
-      (if (save-excursion (beginning-of-line) (looking-at "[ \t]*;"))
-	  (progn
-	    (setq exp (buffer-substring (point) pt))
-	    (while (string-match "\n[ \t]*;+" exp start)
-	      (setq start (1+ (match-beginning 0))
-		    exp (concat (substring exp 0 start)
-				(substring exp (match-end 0)))))
-	    (setq exp (read exp)))
-	(setq exp (read (current-buffer)))))
-    (set-syntax-table stab)
-    (if arg
-	(insert (pp-to-string (eval exp)))
-      (pp-eval-expression exp))))
-
-;;; Test cases for quote
-;; (pp-eval-expression ''(quote quote))
-;; (pp-eval-expression ''((quote a) (quote b)))
-;; (pp-eval-expression ''('a 'b))	; same as above
-;; (pp-eval-expression ''((quote (quote quote)) (quote quote)))
-;; These do not satisfy the quote test.
-;; (pp-eval-expression ''quote)
-;; (pp-eval-expression ''(quote))
-;; (pp-eval-expression ''(quote . quote))
-;; (pp-eval-expression ''(quote a b))
-;; (pp-eval-expression ''(quotefoo))
-;; (pp-eval-expression ''(a b))
-
-(provide 'pp)				; so (require 'pp) works
-
-;;; pp.el ends here.
diff --git a/lisp/emacs-lisp/profile.el b/lisp/emacs-lisp/profile.el
deleted file mode 100644
index d8f8b5f86fa..00000000000
--- a/lisp/emacs-lisp/profile.el
+++ /dev/null
@@ -1,325 +0,0 @@
-;;; profile.el --- generate run time measurements of Emacs Lisp functions
-
-;; Copyright (C) 1992, 1994 Free Software Foundation, Inc.
-
-;; Author: Boaz Ben-Zvi <boaz@lcs.mit.edu>
-;; Created: 07 Feb 1992
-;; Version: 1.0
-;; Adapted-By: ESR
-;; Keywords: lisp, tools
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; DESCRIPTION:
-;; ------------
-;;   This program can be used to monitor running time performance of Emacs Lisp
-;; functions. It takes a list of functions and report the real time spent 
-;; inside these functions. It runs a process with a separate timer program.
-;;   Caveat: the C code in ../lib-src/profile.c requires BSD-compatible
-;; time-of-day functions.  If you're running an AT&T version prior to SVr4,
-;; you may have difficulty getting it to work.  Your X library may supply
-;; the required routines if the standard C library does not.
-
-;; HOW TO USE:
-;; -----------
-;;   Set the variable  profile-functions-list  to the list of functions
-;; (as symbols) You want to profile. Call  M-x  profile-functions to set 
-;; this list on and start using your program.  Note that profile-functions 
-;; MUST be called AFTER all the functions in profile-functions-list have 
-;; been loaded !!   (This call modifies the code of the profiled functions.
-;; Hence if you reload these functions, you need to call  profile-functions  
-;; again! ).
-;;   To display the results do  M-x  profile-results .  For example:
-;;-------------------------------------------------------------------
-;;  (setq profile-functions-list '(sokoban-set-mode-line sokoban-load-game 
-;;	                          sokoban-move-vertical sokoban-move))
-;;  (load "sokoban")
-;;  M-x profile-functions
-;;     ...  I play the sokoban game ..........
-;;  M-x profile-results
-;;
-;;      Function                     Time (Seconds.Useconds)
-;;      ========                     =======================
-;;      sokoban-move                     0.539088
-;;      sokoban-move-vertical            0.410130
-;;      sokoban-load-game                0.453235
-;;      sokoban-set-mode-line            1.949203
-;;-----------------------------------------------------
-;; To clear all the settings to profile use profile-finish. 
-;; To set one function at a time (instead of or in addition to setting the 
-;; above list and  M-x profile-functions) use M-x profile-a-function.
-
-;;; Code:
-
-;;;
-;;;  User modifiable VARIABLES
-;;;
-
-(defvar profile-functions-list nil "*List of functions to profile.")
-(defvar profile-timer-program
-  (concat exec-directory "profile")
-  "*Name of the profile timer program.")
-
-;;;
-;;; V A R I A B L E S
-;;;
-
-(defvar profile-timer-process nil "Process running the timer.")
-(defvar profile-time-list nil 
-    "List of cumulative calls and time for each profiled function.")
-(defvar profile-init-list nil
-    "List of entry time for each function. 
-Both how many times invoked and real time of start.")
-(defvar profile-max-fun-name 0 "Max length of name of any function profiled.")
-(defvar profile-temp-result- nil "Should NOT be used anywhere else.")
-(defvar profile-time (cons 0 0) "Used to return result from a filter.")
-(defvar profile-buffer "*profile*" "Name of profile buffer.")
-
-;;;
-;;; F U N C T I O N S
-;;;
-
-(defun profile-functions (&optional flist)
-  "Profile all the functions listed in `profile-functions-list'.
-With argument FLIST, use the list FLIST instead."
-  (interactive "P")
-  (if (null flist) (setq flist profile-functions-list))
-  (mapcar 'profile-a-function flist))
-
-(defun profile-filter (process input)
-  "Filter for the timer process.  Sets `profile-time' to the returned time."
-  (if (zerop (string-match "\\." input)) 
-      (error "Bad output from %s" profile-timer-program)
-    (setcar profile-time 
-	    (string-to-int (substring input 0 (match-beginning 0))))
-    (setcdr profile-time 
-	    (string-to-int (substring input (match-end 0))))))
-
-
-(defun profile-print (entry)
-  "Print one ENTRY (from `profile-time-list')."
-  (let* ((calls (car (cdr entry)))
-	 (timec (cdr (cdr entry)))
-	 (time (+ (car timec) (/ (cdr timec) (float profile-million))))
-	 (avgtime 0.0))
-    (insert (format (concat "%-"
-			    (int-to-string profile-max-fun-name)
-			    "s%8d%11d.%06d")
-		    (car entry) calls (car timec) (cdr timec))
-	    (if (zerop calls)
-		"\n"
-	      (format "%12d.%06d\n"
-		      (truncate (setq avgtime (/ time calls)))
-		      (truncate (* (- avgtime (ftruncate avgtime))
-				   profile-million))))
-	    )))
-
-(defun profile-results ()
-  "Display profiling results in the buffer `*profile*'.
-\(The buffer name comes from `profile-buffer'.)"
-  (interactive)
-  (switch-to-buffer profile-buffer)
-  (erase-buffer)
-  (insert "Function" (make-string (- profile-max-fun-name 6) ? ))
-  (insert " Calls  Total time (sec)  Avg time per call\n")
-  (insert (make-string profile-max-fun-name ?=) "  ")
-  (insert "======  ================  =================\n")
-  (mapcar 'profile-print profile-time-list))
-    
-(defun profile-reset-timer ()
-  (process-send-string profile-timer-process "z\n"))
-
-(defun profile-check-zero-init-times (entry)
-  "If ENTRY has non zero time, give an error."
-  (let ((time (cdr (cdr entry))))
-    (if (and (zerop (car time)) (zerop (cdr time))) nil ; OK
-      (error "Process timer died while making performance profile."))))
-
-(defun profile-get-time ()
-  "Get time from timer process into `profile-time'."
-  ;; first time or if process dies
-  (if (and (processp profile-timer-process)
-	   (eq 'run (process-status profile-timer-process))) nil
-    (setq profile-timer-process;; [re]start the timer process
-	  (start-process "timer" 
-			 (get-buffer-create profile-buffer) 
-			 profile-timer-program))
-    (set-process-filter profile-timer-process 'profile-filter)
-    (process-kill-without-query profile-timer-process)
-    (profile-reset-timer)
-    ;; check if timer died during time measurement
-    (mapcar 'profile-check-zero-init-times profile-init-list)) 
-  ;; make timer process return current time
-  (process-send-string profile-timer-process "p\n")
-  (accept-process-output))
-
-(defun profile-find-function (fun flist)
-  "Linear search for FUN in FLIST."
-  (if (null flist) nil
-    (if (eq fun (car (car flist))) (cdr (car flist))
-      (profile-find-function fun (cdr flist)))))
-
-(defun profile-start-function (fun)
-  "On entry, keep current time for function FUN."
-  ;; assumes that profile-time contains the current time
-  (let ((init-time (profile-find-function fun profile-init-list)))
-    (if (null init-time) (error "Function %s missing from list" fun))
-    (if (not (zerop (car init-time)));; is it a recursive call ?
-	(setcar init-time (1+ (car init-time)))
-      (setcar init-time 1)		; mark first entry
-      (setq init-time (cdr init-time))
-      (setcar init-time (car profile-time))
-      (setcdr init-time (cdr profile-time)))
-    ))
-	
-(defconst profile-million 1000000)
-
-(defun profile-update-function (fun)
-  "When the call to the function FUN is finished, add its run time."
-  ;; assumes that profile-time contains the current time
-  (let ((init-time (profile-find-function fun profile-init-list))
-	(accum (profile-find-function fun profile-time-list))
-	calls time sec usec)
-    (if (or (null init-time)
-	    (null accum)) (error "Function %s missing from list" fun))
-    (setq calls (car accum))
-    (setq time (cdr accum))
-    (setcar init-time (1- (car init-time))) ; pop one level in recursion
-    (if (not (zerop (car init-time))) 
-	nil				; in some recursion level,
-					; do not update cumulated time
-      (setcar accum (1+ calls))
-      (setq init-time (cdr init-time))
-      (setq sec (- (car profile-time) (car init-time))
-	    usec (- (cdr profile-time) (cdr init-time)))
-      (setcar init-time 0)		;  reset time to check for error
-      (setcdr init-time 0)		;  in case timer process dies
-      (if (>= usec 0) nil
-	(setq usec (+ usec profile-million))
-	(setq sec (1- sec)))
-      (setcar time (+ sec (car time)))
-      (setcdr time (+ usec (cdr time)))
-      (if (< (cdr time) profile-million) nil
-	(setcar time (1+ (car time)))
-	(setcdr time (- (cdr time) profile-million)))
-      )))
-
-(defun profile-convert-byte-code (function)
-  (let ((defn (symbol-function function)))
-    (if (byte-code-function-p defn)
-	;; It is a compiled code object.
-	(let* ((contents (append defn nil))
-	       (body
-		(list (list 'byte-code (nth 1 contents)
-			    (nth 2 contents) (nth 3 contents)))))
-	  (if (nthcdr 5 contents)
-	      (setq body (cons (list 'interactive (nth 5 contents)) body)))
-	  (if (nth 4 contents)
-	      ;; Use `documentation' here, to get the actual string,
-	      ;; in case the compiled function has a reference
-	      ;; to the .elc file.
-	      (setq body (cons (documentation function) body)))
-	  (fset function (cons 'lambda (cons (car contents) body)))))))
-
-(defun profile-a-function (fun)
-  "Profile the function FUN."
-  (interactive "aFunction to profile: ")
-  (profile-convert-byte-code fun)
-  (let ((def (symbol-function fun)) (funlen (length (symbol-name fun))))
-    (if (eq (car def) 'lambda) nil
-      (error "To profile: %s must be a user-defined function" fun))
-    (setq profile-time-list		; add a new entry
-	  (cons (cons fun (cons 0 (cons 0 0))) profile-time-list))
-    (setq profile-init-list		; add a new entry
-	  (cons (cons fun (cons 0 (cons 0 0))) profile-init-list))
-    (if (< profile-max-fun-name funlen) (setq profile-max-fun-name funlen))
-    (fset fun (profile-fix-fun fun def))))
-
-(defun profile-fix-fun (fun def)
-  "Take function FUN and return it fixed for profiling.
-DEF is (symbol-function FUN)."
-  (let (prefix first second third (count 2) inter suffix)
-    (if (< (length def) 3)
-	nil		; nothing to see
-      (setq first (car def) second (car (cdr def))
-	    third (car (nthcdr 2 def)))
-      (setq prefix (list first second))
-      ;; Skip the doc string, if there is a string
-      ;; which serves only as a doc string,
-      ;; and put it in PREFIX.
-      (if (or (not (stringp third)) (not (nthcdr 3 def)))
-	  ;; Either no doc string, or it is also the function value.
-	  (setq inter third) 
-	;; Skip the doc string,
-	(setq count 3
-	      prefix (nconc prefix (list third))
-	      inter (car (nthcdr 3 def))))
-      ;; Check for an interactive spec.
-      ;; If found, put it inu  PREFIX and skip it.
-      (if (not (and (listp inter) 
-		    (eq (car inter) 'interactive)))
-	  nil
-	(setq prefix (nconc prefix (list inter)))
-	(setq count (1+ count)))	; skip this sexp for suffix
-      ;; Set SUFFIX to the function body forms.
-      (setq suffix (nthcdr count def))
-      (if (equal (car suffix) '(profile-get-time))
-	  nil
-	;; Prepare new function definition.
-	(nconc prefix
-	       (list '(profile-get-time)) ; read time
-	       (list (list 'profile-start-function 
-			   (list 'quote fun)))
-	       (list (list 'setq 'profile-temp-result- 
-			   (nconc (list 'progn) suffix)))
-	       (list '(profile-get-time)) ; read time
-	       (list (list 'profile-update-function 
-			   (list 'quote fun)))
-	       (list 'profile-temp-result-)
-	       )))))
-
-(defun profile-restore-fun (fun)
-  "Restore profiled function FUN to its original state."
-  (let ((def (symbol-function (car fun))) body index)
-    ;; move index beyond header
-    (setq index (cdr def))
-    (if (stringp (car (cdr index))) (setq index (cdr index)))
-    (if (and (listp (car (cdr index)))
-	     (eq (car (car (cdr index))) 'interactive))
-	(setq index (cdr index)))
-    (setq body (car (nthcdr 3 index)))
-    (if (and (listp body)		; the right element ?
-	     (eq (car (cdr body)) 'profile-temp-result-))
-	(setcdr index (cdr (car (cdr (cdr body))))))))
-
-(defun profile-finish ()
-  "Stop profiling functions.  Clear all the settings."
-  (interactive)
-  (mapcar 'profile-restore-fun profile-time-list)
-  (setq profile-max-fun-name 0)
-  (setq profile-time-list nil)
-  (setq profile-init-list nil))
-
-(defun profile-quit ()
-  "Kill the timer process."
-  (interactive)
-  (process-send-string profile-timer-process "q\n"))
-
-;;; profile.el ends here
diff --git a/lisp/emacs-lisp/ring.el b/lisp/emacs-lisp/ring.el
deleted file mode 100644
index ac5a72a8e67..00000000000
--- a/lisp/emacs-lisp/ring.el
+++ /dev/null
@@ -1,135 +0,0 @@
-;;; ring.el --- handle rings of items
-
-;; Copyright (C) 1992 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: extensions
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This code defines a ring data structure. A ring is a 
-;;     (hd-index length . vector) 
-;; list. You can insert to, remove from, and rotate a ring. When the ring
-;; fills up, insertions cause the oldest elts to be quietly dropped.
-;;
-;; In ring-ref, 0 is the index of the newest element.  Higher indexes
-;; correspond to older elements until they wrap.
-;;
-;; hd-index = index of the newest item on the ring.
-;; length = number of ring items.
-;;
-;; These functions are used by the input history mechanism, but they can
-;; be used for other purposes as well.
-
-;;; Code:
-
-;;;###autoload
-(defun ring-p (x) 
-  "Returns t if X is a ring; nil otherwise."
-  (and (consp x) (integerp (car x))
-       (consp (cdr x)) (integerp (car (cdr x)))
-       (vectorp (cdr (cdr x)))))
-
-;;;###autoload
-(defun make-ring (size)
-  "Make a ring that can contain SIZE elements."
-  (cons 0 (cons 0 (make-vector size nil))))
-
-(defun ring-insert-at-beginning (ring item)
-  "Add to RING the item ITEM.  Add it at the front (the early end)."
-  (let* ((vec (cdr (cdr ring))) 
-	 (veclen (length vec))
-	 (hd (car ring))
-	 (ln (car (cdr ring))))
-    (setq ln (min veclen (1+ ln))
-	  hd (ring-minus1 hd veclen))
-    (aset vec hd item)
-    (setcar ring hd)
-    (setcar (cdr ring) ln)))
-
-(defun ring-plus1 (index veclen)
-  "INDEX+1, with wraparound"
-  (let ((new-index (+ index 1)))
-    (if (= new-index veclen) 0 new-index)))
-
-(defun ring-minus1 (index veclen)
-  "INDEX-1, with wraparound"
-  (- (if (= 0 index) veclen index) 1))
-
-(defun ring-length (ring)
-  "Number of elements in the ring."
-  (car (cdr ring)))
-
-(defun ring-empty-p (ring)
-  (= 0 (car (cdr ring))))
-
-(defun ring-index (index head ringlen veclen)
-  (setq index (mod index ringlen))
-  (mod (1- (+ head (- ringlen index))) veclen))
-
-(defun ring-insert (ring item)
-  "Insert onto ring RING the item ITEM, as the newest (last) item.
-If the ring is full, dump the oldest item to make room."       
-  (let* ((vec (cdr (cdr ring))) 
-	 (veclen (length vec))
-	 (hd (car ring))
-	 (ln (car (cdr ring))))
-    (prog1
-	(aset vec (mod (+ hd ln) veclen) item)
-      (if (= ln veclen)
-	  (setcar ring (ring-plus1 hd veclen))
-	(setcar (cdr ring) (1+ ln))))))
-
-(defun ring-remove (ring &optional index)
-  "Remove an item from the RING.  Return the removed item.
-If optional INDEX is nil, remove the oldest item.  If it's
-numeric, remove the element indexed."
-  (if (ring-empty-p ring)
-      (error "Ring empty")
-    (let* ((hd (car ring))
-	  (ln (car (cdr ring)))
-	  (vec (cdr (cdr ring)))
-	  (veclen (length vec))
-	  (tl (mod (1- (+ hd ln)) veclen))
-	  oldelt)
-      (if (null index)
-	  (setq index (1- ln)))
-      (setq index (ring-index index hd ln veclen))
-      (setq oldelt (aref vec index))
-      (while (/= index tl)
-	(aset vec index (aref vec (ring-plus1 index veclen)))
-	(setq index (ring-plus1 index veclen)))
-      (aset vec tl nil)
-      (setcar (cdr ring) (1- ln))
-      oldelt)))
-
-(defun ring-ref (ring index)
-  "Returns RING's INDEX element.
-INDEX need not be <= the ring length, the appropriate modulo operation
-will be performed.  Element 0 is the most recently inserted; higher indices
-correspond to older elements until they wrap."
-  (if (ring-empty-p ring)
-      (error "indexed empty ring")
-    (let* ((hd (car ring))  (ln (car (cdr ring)))  (vec (cdr (cdr ring))))
-      (aref vec (ring-index index hd ln (length vec))))))
-
-(provide 'ring)
-
-;;; ring.el ends here
diff --git a/lisp/emacs-lisp/shadow.el b/lisp/emacs-lisp/shadow.el
deleted file mode 100644
index 73650de88c8..00000000000
--- a/lisp/emacs-lisp/shadow.el
+++ /dev/null
@@ -1,203 +0,0 @@
-;;; shadow.el --- Locate Emacs Lisp file shadowings.
-
-;; Copyright (C) 1995 Free Software Foundation, Inc.
-
-;; Author: Terry Jones <terry@santafe.edu>
-;; Keywords: lisp
-;; Created: 15 December 1995
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; The functions in this file detect (`find-emacs-lisp-shadows')
-;; and display (`list-load-path-shadows') potential load-path
-;; problems that arise when Emacs Lisp files "shadow" each other.
-;;
-;; For example, a file XXX.el early in one's load-path will shadow
-;; a file with the same name in a later load-path directory.  When
-;; this is unintentional, it may result in problems that could have
-;; been easily avoided.  This occurs often (to me) when installing a
-;; new version of emacs and something in the site-lisp directory
-;; has been updated and added to the emacs distribution.  The old
-;; version, now outdated, shadows the new one. This is obviously
-;; undesirable.
-;;
-;; The `list-load-path-shadows' function was run when you installed
-;; this version of emacs. To run it by hand in emacs:
-;;
-;;     M-x load-library RET shadow RET
-;;     M-x list-load-path-shadows
-;;
-;; or run it non-interactively via:
-;;
-;;     emacs -batch -l shadow.el -f list-load-path-shadows
-;;
-;; Thanks to Francesco Potorti` <pot@cnuce.cnr.it> for suggestions,
-;; rewritings & speedups.
-
-;;; Code:
-
-(defun find-emacs-lisp-shadows (&optional path)
-  "Return a list of Emacs Lisp files that create shadows.
-This function does the work for `list-load-path-shadows'.
-
-We traverse PATH looking for shadows, and return a \(possibly empty\)
-even-length list of files.  A file in this list at position 2i shadows
-the file in position 2i+1.  Emacs Lisp file suffixes \(.el and .elc\)
-are stripped from the file names in the list.
-
-See the documentation for `list-load-path-shadows' for further information."
-  
-  (or path (setq path load-path))
-
-  (let (true-names			; List of dirs considered.
-	shadows				; List of shadowings, to be returned.
-	files				; File names ever seen, with dirs.
-	dir				; The dir being currently scanned.
-	curr-files			; This dir's Emacs Lisp files.
-	orig-dir			; Where the file was first seen.
-	files-seen-this-dir		; Files seen so far in this dir.
-	file)				; The current file.
-
-  
-    (while path
-
-      (setq dir (file-truename (or (car path) ".")))
-      (if (member dir true-names)
-	  ;; We have already considered this PATH redundant directory.
-	  ;; Show the redundancy if we are interactiver, unless the PATH
-	  ;; dir is nil or "." (these redundant directories are just a
-	  ;; result of the current working directory, and are therefore
-	  ;; not always redundant).
-	  (or noninteractive
-	      (and (car path)
-		   (not (string= (car path) "."))
-		   (message "Ignoring redundant directory %s" (car path))))
-	
-	(setq true-names (append true-names (list dir)))
-	(setq dir (or (car path) "."))
-	(setq curr-files (if (file-accessible-directory-p dir)
-                               (directory-files dir nil ".\\.elc?$" t)))
-	(and curr-files
-	     (not noninteractive)
-	     (message "Checking %d files in %s..." (length curr-files) dir))
-	
-	(setq files-seen-this-dir nil)
-
-	(while curr-files
-
-	  (setq file (car curr-files))
-	  (setq file (substring
-		      file 0 (if (string= (substring file -1) "c") -4 -3)))
-
-	  ;; 'file' now contains the current file name, with no suffix.
-	  (if (member file files-seen-this-dir)
-	      nil
-	  	    
-	    ;; File has not been seen yet in this directory.
-	    ;; This test prevents us declaring that XXX.el shadows
-	    ;; XXX.elc (or vice-versa) when they are in the same directory.
-	    (setq files-seen-this-dir (cons file files-seen-this-dir))
-	      
-	    (if (setq orig-dir (assoc file files))
-		;; This file was seen before, we have a shadowing.
-		(setq shadows
-		      (append shadows
-			      (list (concat (cdr orig-dir) "/" file)
-				    (concat dir "/" file))))
-
-	      ;; Not seen before, add it to the list of seen files.
-	      (setq files (cons (cons file dir) files))))
-
-	  (setq curr-files (cdr curr-files))))
-	(setq path (cdr path)))
-
-    ;; Return the list of shadowings.
-    shadows))
-
-
-;;;###autoload
-(defun list-load-path-shadows ()
-  
-  "Display a list of Emacs Lisp files that shadow other files.
-
-This function lists potential load-path problems.  Directories in the
-`load-path' variable are searched, in order, for Emacs Lisp
-files.  When a previously encountered file name is found again, a
-message is displayed indicating that the later file is \"hidden\" by
-the earlier.
-
-For example, suppose `load-path' is set to
-
-\(\"/usr/gnu/emacs/site-lisp\" \"/usr/gnu/emacs/share/emacs/19.30/lisp\"\)
-
-and that each of these directories contains a file called XXX.el.  Then
-XXX.el in the site-lisp directory is referred to by all of:
-\(require 'XXX\), \(autoload .... \"XXX\"\), \(load-library \"XXX\"\) etc.
-
-The first XXX.el file prevents emacs from seeing the second \(unless
-the second is loaded explicitly via load-file\).
-
-When not intended, such shadowings can be the source of subtle
-problems.  For example, the above situation may have arisen because the
-XXX package was not distributed with versions of emacs prior to
-19.30.  An emacs maintainer downloaded XXX from elsewhere and installed
-it.  Later, XXX was updated and included in the emacs distribution.
-Unless the emacs maintainer checks for this, the new version of XXX
-will be hidden behind the old \(which may no longer work with the new
-emacs version\).
-
-This function performs these checks and flags all possible
-shadowings.  Because a .el file may exist without a corresponding .elc
-\(or vice-versa\), these suffixes are essentially ignored.  A file
-XXX.elc in an early directory \(that does not contain XXX.el\) is
-considered to shadow a later file XXX.el, and vice-versa.
-
-When run interactively, the shadowings \(if any\) are displayed in a
-buffer called `*Shadows*'.  Shadowings are located by calling the
-\(non-interactive\) companion function, `find-emacs-lisp-shadows'."
-  
-  (interactive)
-  (let* ((shadows (find-emacs-lisp-shadows))
-	 (n (/ (length shadows) 2))
-	 (msg (format "%s Emacs Lisp load-path shadowing%s found"
-		      (if (zerop n) "No" (concat "\n" (number-to-string n)))
-		      (if (= n 1) " was" "s were"))))
-    (if (interactive-p)
-	(save-excursion
-	  ;; We are interactive.
-	  ;; Create the *Shadows* buffer and display shadowings there.
-	  (let ((output-buffer (get-buffer-create "*Shadows*")))
-	    (display-buffer output-buffer)
-	    (set-buffer output-buffer)
-	    (erase-buffer)
-	    (while shadows
-	      (insert (format "%s hides %s\n" (car shadows)
-			      (car (cdr shadows))))
-	      (setq shadows (cdr (cdr shadows))))
-	    (insert msg "\n")))
-      ;; We are non-interactive, print shadows via message.
-      (while shadows
-	(message "%s hides %s" (car shadows) (car (cdr shadows)))
-	(setq shadows (cdr (cdr shadows))))
-      (message "%s" msg))))
-
-(provide 'shadow)
-
-;;; shadow.el ends here
diff --git a/lisp/emacs-lisp/tq.el b/lisp/emacs-lisp/tq.el
deleted file mode 100644
index 0de2c48e638..00000000000
--- a/lisp/emacs-lisp/tq.el
+++ /dev/null
@@ -1,123 +0,0 @@
-;;; tq.el --- utility to maintain a transaction queue
-
-;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc.
-
-;; Author: Scott Draves <spot@cs.cmu.edu>
-;; Adapted-By: ESR
-;; Keywords: extensions
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
- 
-;;; manages receiving a stream asynchronously, 
-;;; parsing it into transactions, and then calling
-;;; handler functions
-
-;;; Our basic structure is the queue/process/buffer triple.  Each entry
-;;; of the queue is a regexp/closure/function triple.  We buffer
-;;; bytes from the process until we see the regexp at the head of the
-;;; queue.  Then we call the function with the closure and the
-;;; collected bytes.
-
-;;; Code:
-
-;;;###autoload
-(defun tq-create (process)
-  "Create and return a transaction queue communicating with PROCESS.
-PROCESS should be a subprocess capable of sending and receiving
-streams of bytes.  It may be a local process, or it may be connected
-to a tcp server on another machine."
-  (let ((tq (cons nil (cons process
-			    (generate-new-buffer
-			     (concat " tq-temp-"
-				     (process-name process)))))))
-    (set-process-filter process
-			(`(lambda (proc string)
-			   (tq-filter  '(, tq) string))))
-    tq))
-
-;;; accessors
-(defun tq-queue   (tq) (car tq))
-(defun tq-process (tq) (car (cdr tq)))
-(defun tq-buffer  (tq) (cdr (cdr tq)))
-
-(defun tq-queue-add (tq re closure fn)
-  (setcar tq (nconc (tq-queue tq)
-		    (cons (cons re (cons closure fn)) nil)))
-  'ok)
-
-(defun tq-queue-head-regexp  (tq) (car (car (tq-queue tq))))
-(defun tq-queue-head-fn      (tq) (cdr (cdr (car (tq-queue tq)))))
-(defun tq-queue-head-closure (tq) (car (cdr (car (tq-queue tq)))))
-(defun tq-queue-empty        (tq) (not (tq-queue tq)))
-(defun tq-queue-pop          (tq) (setcar tq (cdr (car tq))) (null (car tq)))
- 
-
-;;; must add to queue before sending!
-(defun tq-enqueue (tq question regexp closure fn)
-  "Add a transaction to transaction queue TQ.
-This sends the string QUESTION to the process that TQ communicates with.
-When the corresponding answer comes back, we call FN
-with two arguments: CLOSURE, and the answer to the question.
-REGEXP is a regular expression to match the entire answer;
-that's how we tell where the answer ends."
-  (tq-queue-add tq regexp closure fn)
-  (process-send-string (tq-process tq) question))
-
-(defun tq-close (tq)
-  "Shut down transaction queue TQ, terminating the process."
-  (delete-process (tq-process tq))
-  (kill-buffer (tq-buffer tq)))
-
-(defun tq-filter (tq string)
-  "Append STRING to the TQ's buffer; then process the new data."
-  (let ((old-buffer (current-buffer)))
-    (unwind-protect
-	(progn
-	  (set-buffer (tq-buffer tq))
-	  (goto-char (point-max))
-	  (insert string)
-	  (tq-process-buffer tq))
-      (set-buffer old-buffer))))
-
-(defun tq-process-buffer (tq)
-  "Check TQ's buffer for the regexp at the head of the queue."
-  (set-buffer (tq-buffer tq))
-  (if (= 0 (buffer-size)) ()
-    (if (tq-queue-empty tq)
-	(let ((buf (generate-new-buffer "*spurious*")))
-	  (copy-to-buffer buf (point-min) (point-max))
-	  (delete-region (point-min) (point))
-	  (pop-to-buffer buf nil)
-	  (error "Spurious communication from process %s, see buffer %s"
-		 (process-name (tq-process tq))
-		 (buffer-name buf)))
-      (goto-char (point-min))
-      (if (re-search-forward (tq-queue-head-regexp tq) nil t)
-	  (let ((answer (buffer-substring (point-min) (point))))
-	    (delete-region (point-min) (point))
-	    (funcall (tq-queue-head-fn tq)
-		     (tq-queue-head-closure tq)
-		     answer)
-	    (tq-queue-pop tq)
-	    (tq-process-buffer tq))))))
-
-(provide 'tq)
-
-;;; tq.el ends here
diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el
deleted file mode 100644
index 40008e29a19..00000000000
--- a/lisp/emacs-lisp/trace.el
+++ /dev/null
@@ -1,314 +0,0 @@
-;;; trace.el --- tracing facility for Emacs Lisp functions
-
-;; Copyright (C) 1993 Free Software Foundation, Inc.
-
-;; Author: Hans Chalupsky <hans@cs.buffalo.edu>
-;; Created: 15 Dec 1992
-;; Keywords: tools, lisp
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;; LCD Archive Entry:
-;; trace|Hans Chalupsky|hans@cs.buffalo.edu|
-;; Tracing facility for Emacs Lisp functions|
-;; 1993/05/18 00:41:16|2.0|~/packages/trace.el.Z|
-
-
-;;; Commentary:
-
-;; Introduction:
-;; =============
-;; A simple trace package that utilizes advice.el. It generates trace 
-;; information in a Lisp-style fashion and inserts it into a trace output
-;; buffer. Tracing can be done in the background (or silently) so that
-;; generation of trace output won't interfere with what you are currently
-;; doing.
-
-;; How to get the latest trace.el:
-;; ===============================
-;; You can get the latest version of this file either via anonymous ftp from 
-;; ftp.cs.buffalo.edu (128.205.32.9) with pathname /pub/Emacs/trace.el,
-;; or send email to hans@cs.buffalo.edu and I'll mail it to you.
-
-;; Requirement:
-;; ============
-;; trace.el needs advice.el version 2.0 or later which you can get from the
-;; same place from where you got trace.el.
-
-;; Restrictions:
-;; =============
-;; - Traced subrs when called interactively will always show nil as the
-;;   value of their arguments.
-;; - Only functions/macros/subrs that are called via their function cell will
-;;   generate trace output, hence, you won't get trace output for:
-;;   + Subrs called directly from other subrs/C-code
-;;   + Compiled calls to subrs that have special byte-codes associated
-;;     with them (e.g., car, cdr, ...)
-;;   + Macros that were expanded during compilation
-;; - All the restrictions that apply to advice.el
-
-;; Installation:
-;; =============
-;; Put this file together with advice.el (version 2.0 or later) somewhere
-;; into your Emacs `load-path', byte-compile it/them for efficiency, and
-;; put the following autoload declarations into your .emacs
-;;
-;;    (autoload 'trace-function "trace" "Trace a function" t)
-;;    (autoload 'trace-function-background "trace" "Trace a function" t)
-;;
-;; or explicitly load it with (require 'trace) or (load "trace").
-
-;; Comments, suggestions, bug reports
-;; ==================================
-;; are strongly appreciated, please email them to hans@cs.buffalo.edu.
-
-;; Usage:
-;; ======
-;; - To trace a function say `M-x trace-function' which will ask you for the
-;;   name of the function/subr/macro to trace, as well as for the buffer
-;;   into which trace output should go.
-;; - If you want to trace a function that switches buffers or does other
-;;   display oriented stuff use `M-x trace-function-background' which will
-;;   generate the trace output silently in the background without popping
-;;   up windows and doing other irritating stuff.
-;; - To untrace a function say `M-x untrace-function'.
-;; - To untrace all currently traced functions say `M-x untrace-all'.
-
-;; Examples:
-;; =========
-;;
-;;  (defun fact (n)
-;;    (if (= n 0) 1
-;;      (* n (fact (1- n)))))
-;;  fact
-;;  
-;;  (trace-function 'fact)
-;;  fact
-;;
-;;  Now, evaluating this...
-;;
-;;  (fact 4)
-;;  24
-;;
-;;  ...will generate the following in *trace-buffer*:
-;;
-;;  1 -> fact: n=4
-;;  | 2 -> fact: n=3
-;;  | | 3 -> fact: n=2
-;;  | | | 4 -> fact: n=1
-;;  | | | | 5 -> fact: n=0
-;;  | | | | 5 <- fact: 1
-;;  | | | 4 <- fact: 1
-;;  | | 3 <- fact: 2
-;;  | 2 <- fact: 6
-;;  1 <- fact: 24
-;;
-;;
-;;  (defun ack (x y z)
-;;    (if (= x 0) 
-;;        (+ y z)
-;;      (if (and (<= x 2) (= z 0)) 
-;;          (1- x)
-;;        (if (and (> x 2) (= z 0)) 
-;;            y
-;;          (ack (1- x) y (ack x y (1- z)))))))
-;;  ack
-;;
-;;  (trace-function 'ack)
-;;  ack
-;;
-;;  Try this for some interesting trace output:
-;;
-;;  (ack 3 3 1)
-;;  27
-;;
-;; 
-;; The following does something similar to the functionality of the package
-;; log-message.el by Robert Potter, which is giving you a chance to look at
-;; messages that might have whizzed by too quickly (you won't see subr
-;; generated messages though):
-;;
-;; (trace-function-background 'message "*Message Log*")
-
-
-;;; Change Log:
-
-;; Revision 2.0 1993/05/18 00:41:16 hans
-;;	* Adapted for advice.el 2.0; it now also works
-;;	  for GNU Emacs-19 and Lemacs
-;;	* Separate function `trace-function-background'
-;;	* Separate pieces of advice for foreground and background tracing
-;;	* Less insane handling of interactive trace buffer specification
-;;	* String arguments and values are now printed properly
-;;
-;; Revision 1.1 1992/12/15 22:45:15 hans
-;;	* Created, first public release
-
-
-;;; Code:
-
-(require 'advice)
-
-;;;###autoload
-(defvar trace-buffer "*trace-output*"
-  "*Trace output will by default go to that buffer.")
-
-;; Current level of traced function invocation:
-(defvar trace-level 0)
-
-;; Semi-cryptic name used for a piece of trace advice:
-(defvar trace-advice-name 'trace-function\ )
-
-;; Used to separate new trace output from previous traced runs:
-(defvar trace-separator (format "%s\n" (make-string 70 ?=)))
-
-(defun trace-entry-message (function level argument-bindings)
-  ;; Generates a string that describes that FUNCTION has been entered at
-  ;; trace LEVEL with ARGUMENT-BINDINGS.
-  (format "%s%s%d -> %s: %s\n"
-	  (mapconcat 'char-to-string (make-string (1- level) ?|) " ")
-	  (if (> level 1) " " "")
-	  level
-	  function
-	  (mapconcat (function
-		      (lambda (binding)
-			(concat
-			 (symbol-name (ad-arg-binding-field binding 'name))
-			 "="
-			 ;; do this so we'll see strings:
-			 (prin1-to-string
-			  (ad-arg-binding-field binding 'value)))))
-		     argument-bindings
-		     " ")))
-
-(defun trace-exit-message (function level value)
-  ;; Generates a string that describes that FUNCTION has been exited at
-  ;; trace LEVEL and that it returned VALUE.
-  (format "%s%s%d <- %s: %s\n"
-	  (mapconcat 'char-to-string (make-string (1- level) ?|) " ")
-	  (if (> level 1) " " "")
-	  level
-	  function
-	  ;; do this so we'll see strings:
-	  (prin1-to-string value)))
-
-(defun trace-make-advice (function buffer background)
-  ;; Builds the piece of advice to be added to FUNCTION's advice info
-  ;; so that it will generate the proper trace output in BUFFER
-  ;; (quietly if BACKGROUND is t).
-  (ad-make-advice
-   trace-advice-name nil t
-   (cond (background
-	  (` (advice
-	      lambda ()
-	      (let ((trace-level (1+ trace-level))
-		    (trace-buffer (get-buffer-create (, buffer))))
-		(save-excursion
-		  (set-buffer trace-buffer)
-		  (goto-char (point-max))
-		  ;; Insert a separator from previous trace output:
-		  (if (= trace-level 1) (insert trace-separator))
-		  (insert
-		   (trace-entry-message
-		    '(, function) trace-level ad-arg-bindings)))
-		ad-do-it
-		(save-excursion
-		  (set-buffer trace-buffer)
-		  (goto-char (point-max))
-		  (insert
-		   (trace-exit-message
-		    '(, function) trace-level ad-return-value)))))))
-	 (t (` (advice
-		lambda ()
-		(let ((trace-level (1+ trace-level))
-		      (trace-buffer (get-buffer-create (, buffer))))
-		  (pop-to-buffer trace-buffer)
-		  (goto-char (point-max))
-		  ;; Insert a separator from previous trace output:
-		  (if (= trace-level 1) (insert trace-separator))
-		  (insert
-		   (trace-entry-message
-		    '(, function) trace-level ad-arg-bindings))
-		  ad-do-it
-		  (pop-to-buffer trace-buffer)
-		  (goto-char (point-max))
-		  (insert
-		   (trace-exit-message
-		    '(, function) trace-level ad-return-value)))))))))
-
-(defun trace-function-internal (function buffer background)
-  ;; Adds trace advice for FUNCTION and activates it.
-  (ad-add-advice
-   function
-   (trace-make-advice function (or buffer trace-buffer) background)
-   'around 'last)
-  (ad-activate function nil))
-
-(defun trace-is-traced (function)
-  (ad-find-advice function 'around trace-advice-name))
-
-;;;###autoload
-(defun trace-function (function &optional buffer)
-  "Traces FUNCTION with trace output going to BUFFER.
-For every call of FUNCTION Lisp-style trace messages that display argument
-and return values will be inserted into BUFFER. This function generates the
-trace advice for FUNCTION and activates it together with any other advice
-there might be!! The trace BUFFER will popup whenever FUNCTION is called.
-Do not use this to trace functions that switch buffers or do any other
-display oriented stuff, use `trace-function-background' instead."
-  (interactive
-   (list
-    (intern (completing-read "Trace function: " obarray 'fboundp t))
-    (read-buffer "Output to buffer: " trace-buffer)))
-  (trace-function-internal function buffer nil))
-
-;;;###autoload
-(defun trace-function-background (function &optional buffer)
-  "Traces FUNCTION with trace output going quietly to BUFFER.
-For every call of FUNCTION Lisp-style trace messages that display argument
-and return values will be inserted into BUFFER. This function generates the
-trace advice for FUNCTION and activates it together with any other advice
-there might be!! Trace output will quietly go to BUFFER without changing
-the window or buffer configuration at all."
-  (interactive
-   (list
-    (intern
-     (completing-read "Trace function in background: " obarray 'fboundp t))
-    (read-buffer "Output to buffer: " trace-buffer)))
-  (trace-function-internal function buffer t))
-
-(defun untrace-function (function)
-  "Untraces FUNCTION and possibly activates all remaining advice.
-Activation is performed with `ad-update', hence remaining advice will get
-activated only if the advice of FUNCTION is currently active. If FUNCTION
-was not traced this is a noop."
-  (interactive
-   (list (ad-read-advised-function "Untrace function: " 'trace-is-traced)))
-  (cond ((trace-is-traced function)
-	 (ad-remove-advice function 'around trace-advice-name)
-	 (ad-update function))))
-
-(defun untrace-all ()
-  "Untraces all currently traced functions."
-  (interactive)
-  (ad-do-advised-functions (function)
-    (untrace-function function)))
-
-(provide 'trace)
-
-;;; trace.el ends here