Merge from trunk.

78 files changed, 9722 insertions, 9271 deletions

diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index ae2900775ac..c2ebb3bbdc6 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -1,6 +1,6 @@
-;;; advice.el --- an overloading mechanism for Emacs Lisp functions
+;;; advice.el --- An overloading mechanism for Emacs Lisp functions  -*- lexical-binding: t -*-
 
-;; Copyright (C) 1993-1994, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 2000-2012 Free Software Foundation, Inc.
 
 ;; Author: Hans Chalupsky <hans@cs.buffalo.edu>
 ;; Maintainer: FSF
@@ -31,10 +31,6 @@
 
 ;;; 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.
-
 ;; Advice is documented in the Emacs Lisp Manual.
 
 ;; @ Introduction:
@@ -51,14 +47,12 @@
 ;; @ Highlights:
 ;; =============
 ;; - Clean definition of multiple, named before/around/after advices
-;;   for functions, macros, subrs and special forms
+;;   for functions and macros.
 ;; - 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.
+;; - Allows re/definition of interactive behavior for commands.
+;; - Every piece of advice can have its documentation string.
 ;; - 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
@@ -67,7 +61,7 @@
 ;;   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
+;; - 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.
@@ -81,23 +75,12 @@
 ;; - 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.
+;;   regular expressions that match advice names.
 
 ;; @ 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 `";; @+"').
+;; You can use `outline-mode' to help you read this documentation (set
+;; `outline-regexp' to `";; @+"').
 ;;
 ;; The four major sections of this file are:
 ;;
@@ -111,9 +94,6 @@
 
 ;; @ 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:
@@ -131,23 +111,12 @@
 ;; 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'.
+;; should know:
 ;;
 ;; If you experience any strange behavior/errors etc. that you attribute to
 ;; Advice or to some ill-advised function do one of the following:
@@ -155,45 +124,37 @@
 ;; - 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 first two 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
+;; or `ad-activate-all'.  `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.
+;; 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
+;; 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
+;; 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.
+;; 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
+;; 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)
@@ -224,18 +185,12 @@
 
 ;; @ Advice documentation:
 ;; =======================
-;; Below is general documentation of the various features of advice. For more
+;; 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: Emacs as released by the GNU Project
-;; - 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 - former keeper of Lemacs and creator of the optimizing
-;;        byte-compiler used in v19s.
+;; - Emacs: Emacs as released by the GNU Project
 ;; - Advice: The name of this package.
 ;; - advices: Short for "pieces of advice".
 
@@ -259,22 +214,22 @@
 ;; <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
+;; 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
+;; 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
+;; 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
+;; 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 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.
 
@@ -290,32 +245,31 @@
 ;;   `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
+;;              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).
+;;              if appropriate.  Only use this if the `defadvice' gets
+;;              actually compiled.
 
 ;; 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
+;; 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,
+;; 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
+;; 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):
@@ -348,20 +302,17 @@
 ;; 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.
+;; more portable argument access macros are also provided (see below).
 
 ;; <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
+;; 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
+;; 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
@@ -370,48 +321,44 @@
 ;;
 ;; 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
+;; 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.
+;; keyword `ad-do-it', which will run 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
+;; 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
+;; 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
+;; 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
+;; 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
+;; 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
+;; 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.
+;; 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.
 
 ;; 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
+;; 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
+;; 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).
 
@@ -423,9 +370,9 @@
 ;;
 ;;    (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
+;; 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):
 
@@ -438,17 +385,17 @@
 
 ;; `(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
+;; 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,
+;; 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
+;; 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,
 ;;
@@ -457,7 +404,7 @@
 ;; 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
+;; 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
@@ -467,7 +414,7 @@
 ;; =======================================================
 ;; 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
+;; 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
@@ -491,26 +438,23 @@
 
 ;; @@@ 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.
+;; 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.  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.
 
 ;; @@ 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'
+;; 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.
+;; invocation of `ad-activate', or 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
@@ -528,7 +472,7 @@
 ;; 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
+;; 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
@@ -536,12 +480,12 @@
 
 ;; `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
+;; 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
+;; 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:
@@ -553,31 +497,26 @@
 
 ;; 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
+;; 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
+;; `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).
+;; defined.  The macros `defun' and `defmacro' 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.
 
 ;; @@ 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
+;; 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.
+;; ange-ftp is a very popular package that used to achieve 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 -
@@ -585,7 +524,7 @@
 ;; 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
+;; 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
@@ -593,17 +532,15 @@
 
 ;; 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
+;; 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
+;; part of the new advised definition.  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
+;; `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)
@@ -613,28 +550,28 @@
 ;;
 ;;    (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
+;; 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-")
+;;    (ad-disable-regexp "\\`ange-ftp-")
 ;;
 ;; and the following call would put that actually into effect:
 ;;
-;;    (ad-activate-regexp "^ange-ftp-")
+;;    (ad-activate-regexp "\\`ange-ftp-")
 ;;
 ;; A safer way would have been to use
 ;;
-;;    (ad-update-regexp "^ange-ftp-")
+;;    (ad-update-regexp "\\`ange-ftp-")
 ;;
 ;; instead which would have only reactivated currently actively advised
-;; functions, but not functions that were currently inactive. All these
+;; functions, but not functions that were currently inactive.  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
+;; 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:
@@ -653,7 +590,7 @@
 ;; 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
+;; 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.
 
@@ -662,16 +599,11 @@
 ;; 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 with
-;; `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
+;; 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
@@ -679,19 +611,19 @@
 
 ;; 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
+;; 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
+;; 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
+;; 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:
+;; 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
@@ -699,32 +631,30 @@
 ;; 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
+;; byte-compiler.
+;; 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
+;; 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.
+;; 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
+;;        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
+;; 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
+;; 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
+;; 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.
 
@@ -736,18 +666,18 @@
 ;;       - `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
+;;       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
+;;       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
+;;       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
+;; 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
@@ -759,30 +689,20 @@
 ;; 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.
+;; 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:
-;; ================================================================
+;; @@ Advising macros 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.
+;; these topics.  Here it suffices to point out that the special treatment
+;; of macros can lead to problems when they get advised.  Macros can create
+;; problems because they get expanded at compile or load 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 cannot be advised.
+;;
+;; MORAL: - Only advise macros when you are absolutely sure what you are doing.
 
 ;; @@ Adding a piece of advice with `ad-add-advice':
 ;; =================================================
@@ -793,12 +713,11 @@
 ;; @@ 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
+;; `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).
+;; function gets activated or deactivated.  One application of this mechanism
+;; is to define file load hooks for files that do not provide such hooks.
 ;; 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:
@@ -809,7 +728,7 @@
 ;;
 ;; 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
+;; 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'.
@@ -824,14 +743,14 @@
 ;;     enabled advices are considered during construction of an advised
 ;;     definition.
 ;; - Activation:
-;;     Redefine an advised function with its advised definition. Constructs
+;;     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
+;;     active.  This can be used to bring all currently advised function up
 ;;     to date with the current state of advice without also activating
 ;;     currently inactive functions.
 ;; - Caching:
@@ -840,7 +759,7 @@
 ;; - 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
+;;     `defadvice'.  That advised definition can then rather cheaply be used
 ;;     during activation without having to construct an advised definition
 ;;     from scratch at runtime.
 
@@ -884,9 +803,6 @@
 ;; @@ 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
@@ -903,12 +819,8 @@
 
 ;; @ Foo games: An advice tutorial
 ;; ===============================
-;; The following tutorial was created in Emacs 18.59. Left-justified
+;; 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:
@@ -1031,19 +943,6 @@
 ;; (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
@@ -1081,20 +980,6 @@
 ;; (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
@@ -1114,9 +999,9 @@
 ;; 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
+;; 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 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)
@@ -1164,24 +1049,6 @@
 ;; "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
@@ -1193,13 +1060,10 @@
 ;;   (print "Let's clean up now!"))
 ;; foo
 ;;
-;; Now `foo' is byte-compiled:
+;; Now `foo's advice 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))
+;; (byte-code-function-p 'ad-Advice-foo)
+;; t
 ;;
 ;; (foo 3)
 ;; "Let's clean up now!"
@@ -1305,7 +1169,7 @@
 ;; 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))
+;; (setq old-definition (symbol-function 'ad-Advice-foo))
 ;; (lambda (x) ....)
 ;;
 ;; (ad-deactivate-regexp "^fg-")
@@ -1317,7 +1181,7 @@
 ;; (ad-activate-regexp "^fg-")
 ;; nil
 ;;
-;; (eq old-definition (symbol-function 'foo))
+;; (eq old-definition (symbol-function 'ad-Advice-foo))
 ;; t
 ;;
 ;; (foo 3)
@@ -1326,14 +1190,6 @@
 ;;
 ;; @@ 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:
 ;;
@@ -1346,9 +1202,7 @@
 ;; (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'):
+;; Now we define it and the forward advice will get activated:
 ;;
 ;; (defun bar (x)
 ;;   "Subtract 1 from X."
@@ -1400,7 +1254,7 @@
 ;; (ad-activate 'fie)
 ;; fie
 ;;
-;; (eq cached-definition (symbol-function 'fie))
+;; (eq cached-definition (symbol-function 'ad-Advice-fie))
 ;; t
 ;;
 ;; (fie 2)
@@ -1408,8 +1262,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
+;; the byte-compiler.  For that to occur in a v18 Emacs you had to put the
+;; `defadvice' inside a `defun' because the v18 compiler did not compile
 ;; top-level forms other than `defun' or `defmacro', for example,
 ;;
 ;; (defun fg-defadvice-fum ()
@@ -1450,18 +1304,16 @@
 ;; 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))
+;; (byte-code-function-p 'ad-Advice-fum)
+;; t
 ;;
 ;; (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
+;; 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':
+;; from scratch.  For example, let's first remove all advice-info for `fum':
 ;;
 ;; (ad-unadvise 'fum)
 ;; (("fie") ("bar") ("foo") ...)
@@ -1474,7 +1326,7 @@
 ;; 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
+;; 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:
 ;;
@@ -1483,7 +1335,7 @@
 ;;
 ;; A new uncompiled advised definition got constructed:
 ;;
-;; (ad-compiled-p (symbol-function 'fum))
+;; (byte-code-function-p 'ad-Advice-fum)
 ;; nil
 ;;
 ;; (fum 2)
@@ -1491,7 +1343,7 @@
 ;;
 ;; 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
+;; 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.
 ;;
@@ -1504,10 +1356,7 @@
 ;; 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.
+;; the subr arguments in mind will break.
 ;;
 ;; Argument access text macros allow one to access arguments of an advised
 ;; function in a portable way without having to worry about all these
@@ -1748,13 +1597,9 @@
 ;; @@ 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")
-
+(require 'macroexp)
+;; At run-time also, since ad-do-advised-functions returns code that uses it.
+(eval-when-compile (require 'cl-lib))
 
 ;; @@ Variable definitions:
 ;; ========================
@@ -1820,84 +1665,6 @@ generates a copy of TREE."
          (funcall fUnCtIoN tReE))
         (t tReE)))
 
-;; this is just faster than `ad-substitute-tree':
-(defun ad-copy-tree (tree)
-  "Return 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:
 ;; ==========================
 
@@ -1911,7 +1678,7 @@ exited prematurely with `(ad-do-return [VALUE])'."
 ;;       (after  adv1 adv2 ...)
 ;;       (activation  adv1 adv2 ...)
 ;;       (deactivation  adv1 adv2 ...)
-;;       (origname . <symbol fbound to origdef>)
+;;       (advicefunname . <symbol fbound to assembled advice function>)
 ;;       (cache . (<advised-definition> . <id>)))
 
 ;; List of currently advised though not necessarily activated functions
@@ -1932,19 +1699,15 @@ exited prematurely with `(ad-do-return [VALUE])'."
      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])
+  "`dolist'-style iterator that maps over advised functions.
+\(ad-do-advised-functions (VAR)
    BODY-FORM...)
 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))
+  (declare (indent 1))
+  `(dolist (,(car varform) ad-advised-functions)
+     (setq ,(car varform) (intern (car ,(car varform))))
+     ,@body))
 
 (defun ad-get-advice-info (function)
   (get function 'ad-advice-info))
@@ -1952,16 +1715,23 @@ On each iteration VAR will be bound to the name of an advised function
 (defmacro ad-get-advice-info-macro (function)
   `(get ,function 'ad-advice-info))
 
-(defmacro ad-set-advice-info (function advice-info)
-  `(put ,function 'ad-advice-info ,advice-info))
+(defsubst ad-set-advice-info (function advice-info)
+  (cond
+   (advice-info
+    (add-function :around (get function 'defalias-fset-function)
+                  #'ad--defalias-fset))
+   ((get function 'defalias-fset-function)
+    (remove-function (get function 'defalias-fset-function)
+                     #'ad--defalias-fset)))
+  (put function 'ad-advice-info advice-info))
 
 (defmacro ad-copy-advice-info (function)
-  `(ad-copy-tree (get ,function 'ad-advice-info)))
+  `(copy-tree (get ,function 'ad-advice-info)))
 
 (defmacro ad-is-advised (function)
   "Return 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-macro function))
+  `(ad-get-advice-info-macro ,function))
 
 (defun ad-initialize-advice-info (function)
   "Initialize the advice info for FUNCTION.
@@ -2001,18 +1771,17 @@ either t or nil, and DEFINITION should be a list of the form
 
 ;; 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))
+(defsubst ad-advice-name (advice) (car advice))
+(defsubst ad-advice-protected (advice) (nth 1 advice))
+(defsubst ad-advice-enabled (advice) (nth 2 advice))
+(defsubst ad-advice-definition (advice) (nth 3 advice))
 
 (defun ad-advice-set-enabled (advice flag)
   (rplaca (cdr (cdr advice)) flag))
 
+(defvar ad-advice-classes '(before around after activation deactivation)
+  "List of defined advice classes.")
+
 (defun ad-class-p (thing)
   (memq thing ad-advice-classes))
 (defun ad-name-p (thing)
@@ -2025,13 +1794,10 @@ either t or nil, and DEFINITION should be a list of the form
 ;; @@ 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))))
+  (cl-dolist (advice (ad-get-advice-info-field function class))
+    (if (ad-advice-enabled advice) (cl-return t))))
 
 (defun ad-has-redefining-advice (function)
   "True if FUNCTION's advice info defines at least 1 redefining advice.
@@ -2044,14 +1810,14 @@ Redefining advices affect the construction of an advised definition."
 (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)
+       (cl-dolist (class ad-advice-classes)
 	 (if (ad-get-advice-info-field function class)
-	     (ad-do-return t)))))
+	     (cl-return t)))))
 
 (defun ad-get-enabled-advices (function class)
   "Return the list of enabled advices of FUNCTION in CLASS."
   (let (enabled-advices)
-    (ad-dolist (advice (ad-get-advice-info-field function class))
+    (dolist (advice (ad-get-advice-info-field function class))
       (if (ad-advice-enabled advice)
 	  (push advice enabled-advices)))
     (reverse enabled-advices)))
@@ -2060,76 +1826,30 @@ Redefining advices affect the construction of an advised definition."
 ;; @@ 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'.
+;; Automatic activation happens when a function gets defined via `defalias',
+;; which calls the `defalias-fset-function' (which we set to
+;; `ad--defalias-fset') instead of `fset', if non-nil.
 
-;; The functionality of the new `fset' is as follows:
-;;
-;;     fset(sym,newdef)
-;;       assign NEWDEF to SYM
-;;       if (get SYM 'ad-advice-info)
-;;          ad-activate-internal(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-internal' 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-internal' 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' by using `ad-with-auto-activation-disabled' where
-;; appropriate, especially in a safe version of `fset'.
+(defalias 'ad-activate-internal 'ad-activate)
 
-;; For now define `ad-activate-internal' to the dummy definition:
-(defun ad-activate-internal (function &optional compile)
-  "Automatic advice activation is disabled. `ad-start-advice' enables it."
-  nil)
+(defun ad-make-advicefunname (function)
+  "Make name to be used to call the assembled advice function."
+  (intern (format "ad-Advice-%s" function)))
 
-;; This is just a copy of the above:
-(defun ad-activate-internal-off (function &optional compile)
-  "Automatic advice activation is disabled. `ad-start-advice' enables it."
-  nil)
+(defun ad-get-orig-definition (function) ;FIXME: Rename to "-unadvised-".
+  (if (symbolp function)
+      (setq function (if (fboundp function)
+                         (advice--strip-macro (symbol-function function)))))
+  (while (advice--p function) (setq function (advice--cdr function)))
+  function)
 
-;; This will be t for top-level calls to `ad-activate-internal-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-internal' 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 valid 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)
-  "Make 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)))
+(defun ad-clear-advicefunname-definition (function)
+  (let ((advicefunname (ad-get-advice-info-field function 'advicefunname)))
+    (advice-remove function advicefunname)
+    (fmakunbound advicefunname)))
 
 
 ;; @@ Interactive input functions:
@@ -2147,7 +1867,7 @@ function at point for which PREDICATE returns non-nil)."
       (error "ad-read-advised-function: There are no advised functions"))
   (setq default
 	(or default
-	    ;; Prefer func name at point, if it's in ad-advised-functions etc.
+	    ;; Prefer func name at point, if it's an advised function etc.
 	    (let ((function (progn
 			      (require 'help)
 			      (function-called-at-point))))
@@ -2156,24 +1876,20 @@ function at point for which PREDICATE returns non-nil)."
 		   (or (null predicate)
 		       (funcall predicate function))
 		   function))
-	    (ad-do-advised-functions (function)
-	      (if (or (null predicate)
-		      (funcall predicate function))
-		  (ad-do-return function)))
+            (cl-block nil
+              (ad-do-advised-functions (function)
+                (if (or (null predicate)
+                        (funcall predicate function))
+                    (cl-return function))))
 	    (error "ad-read-advised-function: %s"
 		   "There are no qualifying advised functions")))
-  (let* ((ad-pReDiCaTe predicate)
-	 (function
+  (let* ((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))))))
+               (lambda (function)
+                 (funcall predicate (intern (car function)))))
 	   t)))
     (if (equal function "")
 	(if (ad-is-advised default)
@@ -2192,9 +1908,9 @@ 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)
+	    (cl-dolist (class ad-advice-classes)
 	      (if (ad-get-advice-info-field function class)
-		  (ad-do-return class)))
+		  (cl-return class)))
 	    (error "ad-read-advice-class: `%s' has no advices" function)))
   (let ((class (completing-read
 		(format "%s (default %s): " (or prompt "Class") default)
@@ -2263,18 +1979,18 @@ NAME can be a symbol or a regular expression matching part of an advice name.
 If CLASS is `any' all valid advice classes will be checked."
   (if (ad-is-advised function)
       (let (found-advice)
-	(ad-dolist (advice-class ad-advice-classes)
+	(cl-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
+		    (cl-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))))))
+			  (cl-return advice)))))
+	  (if found-advice (cl-return found-advice))))))
 
 (defun ad-enable-advice-internal (function class name flag)
   "Set enable FLAG of FUNCTION's advices in CLASS matching NAME.
@@ -2285,10 +2001,10 @@ 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)
+	(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))
+	      (dolist (advice (ad-get-advice-info-field
+                               function advice-class))
 		(cond ((or (and (stringp name)
 				(string-match
 				 name (symbol-name (ad-advice-name advice))))
@@ -2393,7 +2109,7 @@ See Info node `(elisp)Computed Advice' for detailed documentation."
   (cond ((not (ad-is-advised function))
          (ad-initialize-advice-info function)
 	 (ad-set-advice-info-field
-	  function 'origname (ad-make-origname function))))
+	  function 'advicefunname (ad-make-advicefunname function))))
   (let* ((previous-position
 	  (ad-advice-position function class (ad-advice-name advice)))
 	 (advices (ad-get-advice-info-field function class))
@@ -2426,12 +2142,6 @@ See Info node `(elisp)Computed Advice' for detailed documentation."
   "Take a macro function DEFINITION and make a lambda out of it."
   `(cdr ,definition))
 
-(defun ad-special-form-p (definition)
-  "Non-nil if and only if DEFINITION is a special form."
-  (if (and (symbolp definition) (fboundp definition))
-      (setq definition (indirect-function definition)))
-  (and (subrp definition) (eq (cdr (subr-arity definition)) 'unevalled)))
-
 (defmacro ad-subr-p (definition)
   ;;"non-nil if DEFINITION is a subr."
   (list 'subrp definition))
@@ -2449,12 +2159,6 @@ See Info node `(elisp)Computed Advice' for detailed documentation."
   ;;"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)
   "Return non-nil if DEFINITION is a compiled byte-code object."
   `(or (byte-code-function-p ,definition)
@@ -2477,10 +2181,8 @@ See Info node `(elisp)Computed Advice' for detailed documentation."
 	 (cdr definition))
 	(t nil)))
 
-(defun ad-arglist (definition &optional name)
-  "Return 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."
+(defun ad-arglist (definition)
+  "Return the argument list of DEFINITION."
   (require 'help-fns)
   (help-function-arglist
    (if (or (ad-macro-p definition) (ad-advice-p definition))
@@ -2492,7 +2194,7 @@ supplied to make subr arglist lookup more efficient."
   "Return the unexpanded docstring of DEFINITION."
   (let ((docstring
 	 (if (ad-compiled-p definition)
-	     (ad-real-documentation definition t)
+	     (documentation definition t)
 	   (car (cdr (cdr (ad-lambda-expression definition)))))))
     (if (or (stringp docstring)
 	    (natnump docstring))
@@ -2515,13 +2217,16 @@ Like `interactive-form', but also works on pieces of advice."
 		    (if (ad-interactive-form definition) 1 0))
 		 (cdr (cdr (ad-lambda-expression definition)))))))
 
-(defun ad-make-advised-definition-docstring (function)
+(defun ad-make-advised-definition-docstring (_function)
   "Make 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 (see the code for `documentation')."
-  (propertize "Advice doc string" 'ad-advice-info function))
+  (eval-when-compile
+    (propertize "Advice function assembled by advice.el."
+                'dynamic-docstring-function
+                #'ad--make-advised-docstring)))
 
 (defun ad-advised-definition-p (definition)
   "Return non-nil if DEFINITION was generated from advice information."
@@ -2530,27 +2235,26 @@ definition (see the code for `documentation')."
 	  (ad-compiled-p definition))
       (let ((docstring (ad-docstring definition)))
 	(and (stringp docstring)
-	     (get-text-property 0 'ad-advice-info docstring)))))
+	     (get-text-property 0 'dynamic-docstring-function docstring)))))
 
 (defun ad-definition-type (definition)
   "Return symbol that describes the type of DEFINITION."
+  ;; These symbols are only ever used to check a cache entry's validity.
+  ;; The suffix `2' reflects the fact that we're using version 2 of advice
+  ;; representations, so cache entries preactivated with version
+  ;; 1 can't be used.
   (cond
-   ((ad-macro-p definition) 'macro)
-   ((ad-subr-p definition)
-    (if (ad-special-form-p definition)
-        'special-form
-      'subr))
-   ((or (ad-lambda-p definition)
-        (ad-compiled-p definition))
-    'function)
-   ((ad-advice-p definition) 'advice)))
+   ((ad-macro-p definition) 'macro2)
+   ((ad-subr-p definition) 'subr2)
+   ((or (ad-lambda-p definition) (ad-compiled-p definition)) 'fun2)
+   ((ad-advice-p definition) 'advice2))) ;; FIXME: Can this ever happen?
 
 (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))))
+       (not (autoloadp (symbol-function function)))))
 
 ;; The following two are necessary for the sake of packages such as
 ;; ange-ftp which redefine functions via fcell indirection:
@@ -2563,9 +2267,9 @@ For that it has to be fbound with a non-autoload definition."
 	  definition))))
 
 (defun ad-real-orig-definition (function)
-  "Find FUNCTION's real original definition starting from its `origname'."
-  (if (ad-is-advised function)
-      (ad-real-definition (ad-get-advice-info-field function 'origname))))
+  (let* ((fun1 (ad-get-orig-definition function))
+         (fun2 (indirect-function fun1)))
+    (unless (autoloadp fun2) fun2)))
 
 (defun ad-is-compilable (function)
   "True if FUNCTION has an interpreted definition that can be compiled."
@@ -2574,60 +2278,17 @@ For that it has to be fbound with a non-autoload definition."
 	   (ad-macro-p (symbol-function function)))
        (not (ad-compiled-p (symbol-function function)))))
 
+(defvar warning-suppress-types)         ;From warnings.el.
 (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
-       (require 'bytecomp)
-       (require 'warnings)              ;To define warning-suppress-types
-                                        ;before we let-bind it.
-       (let ((symbol (make-symbol "advice-compilation"))
-	     (byte-compile-warnings byte-compile-warnings)
-             ;; Don't pop up windows showing byte-compiler warnings.
-             (warning-suppress-types '((bytecomp))))
-	 (if (featurep 'cl)
-	     (byte-compile-disable-warning 'cl-functions))
-	 (fset symbol (symbol-function function))
-	 (byte-compile symbol)
-	 (fset function (symbol-function symbol))))))
-
-
-;; @@ 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))))
+  "Byte-compile the assembled advice function."
+  (require 'bytecomp)
+  (require 'warnings)  ;To define warning-suppress-types before we let-bind it.
+  (let ((byte-compile-warnings byte-compile-warnings)
+        ;; Don't pop up windows showing byte-compiler warnings.
+        (warning-suppress-types '((bytecomp))))
+    (if (featurep 'cl)
+        (byte-compile-disable-warning 'cl-functions))
+    (byte-compile (ad-get-advice-info-field function 'advicefunname))))
 
 ;; @@@ Accessing argument lists:
 ;; =============================
@@ -2739,24 +2400,20 @@ 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))
+      (push (if (symbolp argument-access)
+                (ad-set-argument
+                 arglist index
+                 (ad-element-access values-index 'ad-vAlUeS))
+              (setq arglist nil) ;; Terminate loop.
+              (if (= (car argument-access) 0)
+                  `(setq
+                    ,(car (cdr argument-access))
+                    ,(ad-list-access values-index 'ad-vAlUeS))
+                `(setcdr
+                  ,(ad-list-access (1- (car argument-access))
+                                   (car (cdr argument-access)))
+                  ,(ad-list-access values-index 'ad-vAlUeS))))
+            set-forms)
       (setq index (1+ index))
       (setq values-index (1+ values-index)))
     (if (null set-forms)
@@ -2765,8 +2422,8 @@ The assignment starts at position INDEX."
         (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))
+             (lambda (form) (eq form 'ad-vAlUeS))
+             (lambda (_form) values-form)
              (car set-forms))
             ;; ...if we have more we have to bind it to a variable:
             `(let ((ad-vAlUeS ,values-form))
@@ -2818,7 +2475,7 @@ 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))'."
+         `(funcall ad--addoit-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)))
@@ -2832,15 +2489,14 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return
     ;; 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)
+    (append (list (if need-apply 'apply 'funcall) 'ad--addoit-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)))
+		  (t (mapcar (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
@@ -2848,13 +2504,6 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return
 					  (nthcdr (length target-reqopt-args)
 						  source-reqopt-args)))))))))
 
-(defun ad-make-mapped-call (source-arglist target-arglist target-function)
-  "Make 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:
 ;; ===========================================
@@ -2871,11 +2520,6 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return
   (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 (if advice-docstring
 		 (format "%s-advice `%s':\n%s"
 			 (capitalize (symbol-name class))
@@ -2887,27 +2531,24 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return
 
 (require 'help-fns)	    ;For help-split-fundoc and help-add-fundoc-usage.
 
-(defun ad-make-advised-docstring (function &optional style)
+(defun ad--make-advised-docstring (origdoc function &optional style)
   "Construct 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
+according to STYLE.  STYLE can be `plain', 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))
-	 (usage (help-split-fundoc origdoc function))
-	 paragraphs advice-docstring ad-usage)
+  (if (and (symbolp function)
+           (string-match "\\`ad-+Advice-" (symbol-name function)))
+      (setq function
+            (intern (substring (symbol-name function) (match-end 0)))))
+  (let* ((usage (help-split-fundoc origdoc function))
+	 paragraphs advice-docstring)
     (setq usage (if (null usage) t (setq origdoc (cdr usage)) (car usage)))
     (if origdoc (setq paragraphs (list origdoc)))
-    (unless (eq style 'plain)
-      (push (concat "This " origtype " is advised.") paragraphs))
-    (ad-dolist (class ad-advice-classes)
-      (ad-dolist (advice (ad-get-enabled-advices function class))
+    (dolist (class ad-advice-classes)
+      (dolist (advice (ad-get-enabled-advices function class))
 	(setq advice-docstring
 	      (ad-make-single-advice-docstring advice class style))
 	(if advice-docstring
@@ -2916,37 +2557,35 @@ in any of these classes."
 		      (propertize
 		       ;; separate paragraphs with blank lines:
 		       (mapconcat 'identity (nreverse paragraphs) "\n\n")
-		       'ad-advice-info function)))
+                       ;; FIXME: what is this for?
+		       'dynamic-docstring-function
+                       #'ad--make-advised-docstring)))
     (help-add-fundoc-usage origdoc usage)))
 
-(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)
   "Find first defined arglist in FUNCTION's redefining advices."
-  (ad-dolist (advice (append (ad-get-enabled-advices function 'before)
+  (cl-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)))))
+	  (cl-return arglist)))))
 
 (defun ad-advised-interactive-form (function)
   "Find first interactive form in FUNCTION's redefining advices."
-  (ad-dolist (advice (append (ad-get-enabled-advices function 'before)
+  (cl-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)))))
+	  (cl-return interactive-form)))))
 
 ;; @@@ Putting it all together:
 ;; ============================
@@ -2956,64 +2595,18 @@ in any of these classes."
   (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 (commandp 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))
+	     (orig-arglist (let ((args (ad-arglist origdef)))
+                             ;; The arglist may still be unknown.
+                             (if (listp args) args '(&rest args))))
 	     (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)
-		    ((interactive-form origdef)
-		     (interactive-form
-                      (if (and (symbolp function) (get function 'elp-info))
-                          (aref (get function 'elp-info) 2)
-                        origdef)))))
+	     (interactive-form (ad-advised-interactive-form function))
 	     (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 interactive-form)
-			  (not advised-interactive-form))
-		     ;; Check whether we were called interactively
-		     ;; in order to do proper prompting:
-		     `(if (called-interactively-p 'any)
-			  (call-interactively ',origname)
-			,(ad-make-mapped-call advised-arglist
-					      orig-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)))))
+              (ad-map-arglists advised-arglist orig-arglist)))
 
 	;; 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
@@ -3023,71 +2616,67 @@ in any of these classes."
 	 (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,
+    (args docstring interactive orig &optional befores arounds afters)
+  "Assemble the advices into an overall advice function.
+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))))))
+  ;; The ad-do-it call should always have the right number of arguments,
+  ;; but the compiler might signal a bogus warning because it checks the call
+  ;; against the advertised calling convention.
+  (let ((around-form `(setq ad-return-value (with-no-warnings ,orig)))
+        before-forms around-form-protected after-forms definition)
+    (dolist (advice befores)
+      (cond ((and (ad-advice-protected advice)
+                  before-forms)
+             (setq before-forms
+                   `((unwind-protect
+                         ,(macroexp-progn before-forms)
+                       ,@(ad-body-forms
+                          (ad-advice-definition advice))))))
+            (t (setq before-forms
+                     (append before-forms
+                             (ad-body-forms (ad-advice-definition advice)))))))
+
+    (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
+             (lambda (form) (eq form 'ad-do-it))
+             (lambda (_form) around-form)
+             (macroexp-progn (ad-body-forms (ad-advice-definition advice))))))
 
     (setq after-forms
 	  (if (and around-form-protected before-forms)
 	      `((unwind-protect
-                     ,(ad-prognify before-forms)
+                     ,(macroexp-progn 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)))))))
+    (dolist (advice afters)
+      (cond ((and (ad-advice-protected advice)
+                  after-forms)
+             (setq after-forms
+                   `((unwind-protect
+                         ,(macroexp-progn 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
+	  `(lambda (ad--addoit-function ,@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-return-value)))
 
     (ad-insert-argument-access-forms definition args)))
 
@@ -3099,7 +2688,7 @@ should be modified.  The assembled function will be returned."
 			     (ad-body-forms (ad-advice-definition advice))))
 		 (ad-get-enabled-advices function hook-name))))
     (if hook-forms
-	(ad-prognify (apply 'append hook-forms)))))
+	(macroexp-progn (apply 'append hook-forms)))))
 
 
 ;; @@ Caching:
@@ -3184,17 +2773,17 @@ advised definition from scratch."
   "Generate 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)))
+    (list (mapcar #'ad-advice-name
 		  (ad-get-enabled-advices function 'before))
-	  (mapcar (function (lambda (advice) (ad-advice-name advice)))
+	  (mapcar #'ad-advice-name
 		  (ad-get-enabled-advices function 'around))
-	  (mapcar (function (lambda (advice) (ad-advice-name advice)))
+	  (mapcar #'ad-advice-name
 		  (ad-get-enabled-advices function 'after))
 	  (ad-definition-type original-definition)
-	  (if (equal (ad-arglist original-definition function)
+	  (if (equal (ad-arglist original-definition)
 		     (ad-arglist cached-definition))
 	      t
-	    (ad-arglist original-definition function))
+	    (ad-arglist original-definition))
 	  (if (eq (ad-definition-type original-definition) 'function)
 	      (equal (interactive-form original-definition)
 		     (interactive-form cached-definition))))))
@@ -3209,11 +2798,11 @@ advised definition from scratch."
 	(nth 2 cache-id)))))
 
 (defun ad-verify-cache-class-id (cache-class-id advices)
-  (ad-dolist (advice advices (null cache-class-id))
+  (cl-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)))))
+	  (cl-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
@@ -3239,7 +2828,7 @@ advised definition from scratch."
 	   (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)
+			   (ad-arglist original-definition)
 			 (nth 4 cache-id) )
 		       (ad-arglist cached-definition))
 		(setq code 'interactive-form-mismatch)
@@ -3298,94 +2887,10 @@ advised definition from scratch."
       (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)
+	  (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:
 ;; ======================================
 
@@ -3415,25 +2920,32 @@ 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)))
+	     (ad-get-cache-definition function)))
+        (advicefunname (ad-get-advice-info-field function 'advicefunname)))
+    (fset advicefunname
+          (or verified-cached-definition
+              (ad-make-advised-definition function)))
+    (advice-add function :around advicefunname)
     (if (ad-should-compile function compile)
-	(ad-compile-function function))
+	(byte-compile advicefunname))
     (if verified-cached-definition
-	(if (not (eq verified-cached-definition (symbol-function function)))
+	(if (not (eq verified-cached-definition
+                     (symbol-function advicefunname)))
 	    ;; we must have compiled, cache the compiled definition:
-	    (ad-set-cache
-	     function (symbol-function function) (ad-get-cache-id function)))
+	    (ad-set-cache function (symbol-function advicefunname)
+                          (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 advicefunname) nil)
       (ad-set-cache
-       function (symbol-function function) (ad-make-cache-id function)))))
+       function (symbol-function advicefunname) (ad-make-cache-id function)))))
 
-(defun ad-handle-definition (function)
+(defun ad--defalias-fset (fsetfun function newdef)
+  ;; Besides ad-redefinition-action we use this defalias-fset-function hook
+  ;; for two other reasons:
+  ;; - for `activation/deactivation' advices.
+  ;; - to rebuild the ad-Advice-* function with the right argument names.
   "Handle 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
@@ -3445,33 +2957,27 @@ 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))))
+	(current-definition (ad-get-orig-definition newdef)))
     (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 (eq current-definition original-definition))
+		;; We have a redefinition:
 		(if (not (memq ad-redefinition-action '(accept discard warn)))
-		    (error "ad-handle-definition (see its doc): `%s' %s"
+		    (error "ad-redefinition-action: `%s' %s"
 			   function "invalidly redefined")
 		  (if (eq ad-redefinition-action 'discard)
-		      (ad-safe-fset function original-definition)
-		    (ad-set-orig-definition function current-definition)
+		      nil ;; Just drop it!
+		    (funcall (or fsetfun #'fset) function newdef)
+                    (ad-activate-internal function)
 		    (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))))
+	  ;; We have an undefinition, ignore it:
+          (funcall (or fsetfun #'fset) function newdef))
+      (funcall (or fsetfun #'fset) function newdef)
+      (when current-definition (ad-activate-internal function)))))
 
 
 ;; @@ The top-level advice interface:
@@ -3497,24 +3003,20 @@ 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':
-      (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)))))))))
+  (if (not (ad-is-advised function))
+      (error "ad-activate: `%s' is not advised" 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)))))))
 
 (defalias 'ad-activate-on 'ad-activate)
 
@@ -3529,11 +3031,10 @@ a call to `ad-activate'."
   (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-clear-advicefunname-definition function)
 	     (ad-set-advice-info-field function 'active nil)
 	     (eval (ad-make-hook-form function 'deactivation))
 	     function)))))
@@ -3555,7 +3056,7 @@ If FUNCTION was not advised this will be a noop."
   (cond ((ad-is-advised function)
 	 (if (ad-is-active function)
 	     (ad-deactivate function))
-	 (ad-clear-orig-definition function)
+	 (ad-clear-advicefunname-definition function)
 	 (ad-set-advice-info function nil)
 	 (ad-pop-advised-function function))))
 
@@ -3570,9 +3071,7 @@ Use in emergencies."
    (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-clear-advicefunname-definition function)
 	 (ad-set-advice-info function nil)
 	 (ad-pop-advised-function function))))
 
@@ -3652,7 +3151,7 @@ deactivation, which might run hooks and get into other trouble."
 ;; Completion alist of valid `defadvice' flags
 (defvar ad-defadvice-flags
   '(("protect") ("disable") ("activate")
-    ("compile") ("preactivate") ("freeze")))
+    ("compile") ("preactivate")))
 
 ;;;###autoload
 (defmacro defadvice (function args &rest body)
@@ -3671,7 +3170,7 @@ POSITION ::= `first' | `last' | NUMBER. Optional, defaults to `first',
 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'.
+FLAG ::= `protect'|`disable'|`activate'|`compile'|`preactivate'.
     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
@@ -3697,18 +3196,20 @@ 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.
-
 See Info node `(elisp)Advising Functions' for comprehensive documentation.
 usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...)
           [DOCSTRING] [INTERACTIVE-FORM]
           BODY...)"
-  (declare (doc-string 3))
+  (declare (doc-string 3)
+           (debug (&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)))
   (if (not (ad-name-p function))
       (error "defadvice: Invalid function name: %s" function))
   (let* ((class (car args))
@@ -3744,29 +3245,24 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...)
 			    (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 ',function
-                   ,(if (memq 'compile flags) t))))
-          ',function))))
+    `(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 ',function
+                            ,(if (memq 'compile flags) t))))
+       ',function)))
 
 
 ;; @@ Tools:
@@ -3777,6 +3273,7 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...)
 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."
+  (declare (indent 1))
   (let* ((index -1)
 	 ;; Make let-variables to store current definitions:
 	 (current-bindings
@@ -3793,67 +3290,35 @@ undone on exit of this macro."
                 ;; 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))
+                (mapcar (lambda (function)
+                          (setq index (1+ index))
+                           `(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))))))
+           (mapcar (lambda (function)
+                     (setq index (1+ index))
+                       `(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:
 
 ;; @@ Starting, stopping and recovering from the advice package magic:
 ;; ===================================================================
 
-(defun ad-start-advice ()
-  "Start the automatic advice handling magic."
-  (interactive)
-  ;; Advising `ad-activate-internal' means death!!
-  (ad-set-advice-info 'ad-activate-internal nil)
-  (ad-safe-fset 'ad-activate-internal 'ad-activate))
-
-(defun ad-stop-advice ()
-  "Stop the automatic advice handling magic.
-You should only need this in case of Advice-related emergencies."
-  (interactive)
-  ;; Advising `ad-activate-internal' means death!!
-  (ad-set-advice-info 'ad-activate-internal nil)
-  (ad-safe-fset 'ad-activate-internal 'ad-activate-internal-off))
-
 (defun ad-recover-normality ()
   "Undo all advice related redefinitions and unadvises everything.
 Use only in REAL emergencies."
   (interactive)
-  ;; Advising `ad-activate-internal' means death!!
-  (ad-set-advice-info 'ad-activate-internal nil)
-  (ad-safe-fset 'ad-activate-internal 'ad-activate-internal-off)
   (ad-recover-all)
-  (setq ad-advised-functions nil))
-
-(ad-start-advice)
+  (ad-do-advised-functions (function)
+    (message "Oops! Left over advised function %S" function)
+    (ad-pop-advised-function function)))
 
 (provide 'advice)
 
diff --git a/lisp/emacs-lisp/assoc.el b/lisp/emacs-lisp/assoc.el
deleted file mode 100644
index e650995d3fe..00000000000
--- a/lisp/emacs-lisp/assoc.el
+++ /dev/null
@@ -1,139 +0,0 @@
-;;; assoc.el --- insert/delete functions on association lists
-
-;; Copyright (C) 1996, 2001-2011  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 3 of the License, 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.  If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Association list utilities providing insertion, deletion, sorting
-;; fetching off key-value pairs in association lists.
-
-;;; Code:
-(eval-when-compile (require 'cl))
-
-(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 (symbol-value alist-symbol))
-	     (function (lambda (a b) (equal (car a) key))))))
-
-
-(defun aelement (key value)
-  "Make a list of a cons cell containing car of KEY and cdr of VALUE.
-The returned list is suitable for concatenating with an existing
-alist, via `nconc'."
-  (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)
-  "Insert 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.
-
-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)."
-  (lexical-let ((elem (aelement key value))
-		alist)
-    (asort alist-symbol key)
-    (setq alist (symbol-value 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)) alist)
-	  (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)
-  (lexical-let ((alist (symbol-value 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)
-  "Return 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."
-  (lexical-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))))
-  (symbol-value alist-symbol))
-
-(provide 'assoc)
-
-;;; assoc.el ends here
diff --git a/lisp/emacs-lisp/authors.el b/lisp/emacs-lisp/authors.el
index 596b32f24c3..6c70642ba83 100644
--- a/lisp/emacs-lisp/authors.el
+++ b/lisp/emacs-lisp/authors.el
@@ -1,6 +1,6 @@
-;;; authors.el --- utility for maintaining Emacs' AUTHORS file -*-coding: utf-8;-*-
+;;; authors.el --- utility for maintaining Emacs's AUTHORS file -*-coding: utf-8 -*-
 
-;; Copyright (C) 2000-2011  Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
 
 ;; Author: Gerd Moellmann <gerd@gnu.org>
 ;; Maintainer: Kim F. Storm <storm@cua.dk>
@@ -25,7 +25,7 @@
 ;;; Commentary:
 
 ;; Use M-x authors RET to create an *Authors* buffer that can used as
-;; or merged with Emacs' AUTHORS file.
+;; or merged with Emacs's AUTHORS file.
 
 ;;; Code:
 
@@ -41,23 +41,28 @@ files.")
 (defconst authors-aliases
   '(
     ("Aaron S. Hawley" "Aaron Hawley")
+    ("Alexandru Harsanyi" "Alex Harsanyi")
     ("Andrew Csillag" "Drew Csillag")
     ("Anna M. Bigatti" "Anna Bigatti")
     ("Barry A. Warsaw" "Barry A. Warsaw, Century Computing, Inc."
      "Barry A. Warsaw, ITB" "Barry Warsaw")
+    ("Bill Carpenter" "WJ Carpenter")
     ("Bill Mann" "William F. Mann")
     ("Bill Rozas" "Guillermo J. Rozas")
     ("Björn Torkelsson" "Bjorn Torkelsson")
     ("Brian Fox" "Brian J. Fox")
+    ("Brian Sniffen" "Brian T. Sniffen")
     ("Christoph Wedler" "Christoph.Wedler@sap.com")
     ("Daniel Pfeiffer" "<Daniel.Pfeiffer@Informatik.START.db.de>"
      "<Daniel.Pfeiffer@Informatik.START.dbp.de>")
+    ("David Abrahams" "Dave Abrahams")
     ("David De La Harpe Golden" "David Golden")
     ("David Gillespie" "Dave Gillespie")
     ("David Kågedal" "David K..edal")
     ("David M. Koppelman" "David M. Koppelman, Koppel@Ec?e.Lsu.Edu"
      "David Koppelman")
     ("David M. Smith" "David Smith" "David M Smith")
+    ("David O'Toole" "David T. O'Toole")
     ("Deepak Goel" "D. Goel")
     ("Ed L. Cashin" "Ed L Cashin")
     ("Edward M. Reingold" "Ed Reingold" "Edward M Reingold"
@@ -76,6 +81,8 @@ files.")
     ("Gerd Möllmann" "Gerd Moellmann")
     ("Hallvard B. Furuseth" "Hallvard B Furuseth" "Hallvard Furuseth")
     ("Hrvoje Nikšić" "Hrvoje Niksic")
+    ;; lisp/org/ChangeLog 2010-11-11.
+    (nil "aaa bbb")
     ;; src/ChangeLog.4, 1994-01-11, since fixed.
 ;;;    (nil "(afs@hplb.hpl.hp.com)")
     ;; lisp/gnus/ChangeLog.1, 1998-01-15.
@@ -92,6 +99,7 @@ files.")
     ("Jens-Ulrik Holger Petersen" "Jens-Ulrik Petersen")
     ("Jeremy Bertram Maitin-Shepard" "Jeremy Maitin-Shepard")
     ("Johan Bockgård" "Johan Bockgard")
+    ("John J Foerch" "John Foerch")
     ("John W. Eaton" "John Eaton")
     ("Jonathan I. Kamens" "Jonathan Kamens")
     ("Joseph Arceneaux" "Joe Arceneaux")
@@ -109,10 +117,11 @@ files.")
     ("Kevin Greiner" "Kevin J. Greiner")
     ("Kim F. Storm" "Kim Storm")
     ("Kyle Jones" "Kyle E. Jones")
+    ("Lars Magne Ingebrigtsen" "Lars Ingebrigtsen")
     ("Marcus G. Daniels" "Marcus Daniels")
     ("Mark D. Baushke" "Mark D Baushke")
     ("Marko Kohtala" "Kohtala Marko")
-    ("Agustín Martín" "Agustin Martin")
+    ("Agustín Martín" "Agustin Martin" "Agustín Martín Domingo")
     ("Martin Lorentzon" "Martin Lorentzson")
     ("Matt Swift" "Matthew Swift")
     ("Maxime Edouard Robert Froumentin" "Max Froumentin")
@@ -124,12 +133,14 @@ files.")
     ("Michael Sperber" "Michael Sperber \\[Mr. Preprocessor\\]")
     ("Mikio Nakajima" "Nakajima Mikio")
     ("Nelson Jose dos Santos Ferreira" "Nelson Ferreira")
+    ("Noorul Islam" "Noorul Islam K M")
     ("Paul Eggert" "eggert")
     ("Paul Reilly" "(pmr@legacy.pajato.com)")
     ("Pavel Janík" "Pavel Janík Ml." "Pavel Janik Ml." "Pavel Janik" "Pavel Janík" "Pavel@Janik.Cz")
     ("Pavel Kobiakov" "Pavel Kobyakov")
     ("Per Abrahamsen" "Per Abhiddenware")
     ("Per Starbäck" "Per Starback")
+    ("Peter J. Weisberg" "PJ Weisberg")
     ("Peter S. Galbraith" "Peter Galbraith")
     ("Peter Runestig" "Peter 'luna' Runestig")
     ("Peter S. Galbraith" "Peter S Galbraith")
@@ -144,23 +155,28 @@ files.")
     ("Sacha Chua" "Sandra Jean Chua")
     ("Sam Steingold" "Sam Shteingold")
     ("Satyaki Das" "Indexed search by Satyaki Das")
+    ("Sébastien Vauban" "Sebastien Vauban")
     ;; There are other Stefans.
 ;;;    ("Stefan Monnier" "Stefan")
     ("Stephen A. Wood" "(saw@cebaf.gov)")
     ("Steven L. Baur" "SL Baur" "Steven L Baur")
     ("Stewart M. Clamen" "Stewart Clamen")
     ("Stuart D. Herring" "Stuart Herring" "Davis Herring")
+    ("T.V. Raman" "T\\. V\\. Raman")
     ("Taichi Kawabata" "KAWABATA,? Taichi")
     ("Takaaki Ota" "Tak Ota")
     ("Takahashi Naoto" "Naoto Takahashi")
     ("Teodor Zlatanov" "Ted Zlatanov")
+    ("Thomas Dye" "Tom Dye")
     ("Thomas Horsley" "Tom Horsley")	; FIXME ?
     ("Thomas Wurgler" "Tom Wurgler")
+    ("Toby Cubitt" "Toby S\\. Cubitt")
     ("Tomohiko Morioka" "MORIOKA Tomohiko")
     ("Torbjörn Axelsson" "Torbjvrn Axelsson")
     ("Torbjörn Einarsson" "Torbj.*rn Einarsson")
     ("Toru Tomabechi" "Toru Tomabechi,")
     ("Tsugutomo Enami" "enami tsugutomo")
+    ("Ulrich Müller" "Ulrich Mueller")
     ("Vincent Del Vecchio" "Vince Del Vecchio")
     ("William M. Perry" "Bill Perry")
     ("Wlodzimierz Bzyl" "W.*dek Bzyl")
@@ -174,6 +190,7 @@ Each entry is of the form (REALNAME REGEXP...).  If an author's name
 matches one of the REGEXPs, use REALNAME instead.
 If REALNAME is nil, ignore that author.")
 
+;; FIXME seems it would be less fragile to check for O', Mc, etc.
 (defconst authors-fixed-case
   '("Bryan O'Sullivan"
     "Christian von Roques"
@@ -182,6 +199,7 @@ If REALNAME is nil, ignore that author.")
     "David J. MacKenzie"
     "David McCabe"
     "David O'Toole"
+    "Devon Sean McCullough"
     "Dominique de Waleffe"
     "Edward O'Connor"
     "Exal de Jesus Garcia Carrillo"
@@ -194,8 +212,11 @@ If REALNAME is nil, ignore that author.")
     "Nelson Jose dos Santos Ferreira"
     "Peter von der Ahe"
     "Peter O'Gorman"
+    "Piet van Oostrum"
     "Roland McGrath"
-    "Sean O'Rourke")
+    "Sean O'Halpin"
+    "Sean O'Rourke"
+    "Tijs van Bakel")
   "List of authors whose names cannot be simply capitalized.")
 
 (defvar authors-public-domain-files
@@ -222,11 +243,12 @@ If REALNAME is nil, ignore that author.")
     ".*loaddefs.el$"			; not obsolete, but auto-generated
     "\\.\\(cvs\\|git\\)ignore$"		; obsolete or uninteresting
     "\\.arch-inventory$"
+    ;; TODO lib/? Matches other things?
+    "build-aux/" "m4/" "Emacs.xcodeproj" "charsets" "mapfiles"
     "preferences\\.\\(nib\\|gorm\\)"
     "vc-\\(rcs\\|cvs\\|sccs\\)-hooks\\.el$")
   "List of regexps matching obsolete files.
-Changes to files matching one of the regexps in this list are not
-listed.")
+Changes to files matching one of the regexps in this list are not listed.")
 
 (defconst authors-ignored-files
   '("external-lisp"
@@ -257,7 +279,12 @@ listed.")
     "*.el"
     ;; Autogen:
     "cus-load.el" "finder-inf.el" "ldefs-boot.el"
+    "compile" "config.guess" "config.sub" "depcomp"
+    ;; Only existed briefly, then renamed:
+    "images/icons/allout-widgets-dark-bg"
+    "images/icons/allout-widgets-light-bg"
     ;; Never had any meaningful changes logged, now deleted:
+    "unidata/bidimirror.awk" "unidata/biditype.awk"
     "split-man" "Xkeymap.txt" "ms-7bkermit" "ulimit.hack"
     "gnu-hp300" "refcard.bit" "ledit.l" "forms.README" "forms-d2.dat"
     "CXTERM-DIC/PY.tit" "CXTERM-DIC/ZIRANMA.tit"
@@ -308,29 +335,47 @@ Changes to files in this list are not listed.")
     "complete.el"
     "cpp.el"
     "ctxt.el"
+    "custom.el"
+    "cyrillic.el"
+    "czech.el"
     "debug.el"
     "dired.el"
     "el.el"
+    "eshell.el"
+    "ethiopic.el"
+    "f90.el"
     "files.el"
     "find.el"
     "format.el"
+    "generic.el"
+    "georgian.el"
+    "greek.el"
     "grep.el"
+    "hebrew.el"
     "imenu.el"
+    "indian.el"
+    "japanese.el"
     "java.el"
+    "lao.el"
     "linux.el"
     "locate.el"
     "make.el"
     "mode.el"
     "python.el"
+    "rmailmm.el"
     "semantic.el"
     "shell.el"
     "simple.el"
+    "slovak.el"
     "sort.el"
     "speedbar.el"
     "srecode.el"
     "table.el"
     "texi.el"
+    "thai.el"
+    "tibetan.el"
     "util.el"
+    "vc-bzr.el"
     "wisent.el")
   "List of basenames occurring more than once in the source.")
 
@@ -354,7 +399,7 @@ Changes to files in this list are not listed.")
     ("Lawrence R. Dodd" :cowrote "dired-x.el")
     ;; No longer distributed.
 ;;;    ("Viktor Dukhovni" :wrote "unexsunos4.c")
-    ("Paul Eggert" :wrote "rcs2log" "vcdiff")
+    ("Paul Eggert" :wrote "rcs2log") ; "vcdiff"
     ("Fred Fish" :changed "unexcoff.c")
     ;; No longer distributed.
 ;;;    ("Tim Fleehart" :wrote "makefile.nt")
@@ -382,7 +427,7 @@ Changes to files in this list are not listed.")
     ;; No longer distributed.
 ;;;    ("Ishikawa Chiaki" :changed "aviion.h" "dgux.h")
     ;; ymakefile no longer distributed.
-    ("Michael K. Johnson" :changed "configure.in" "emacs.c" "intel386.h"
+    ("Michael K. Johnson" :changed "configure.ac" "emacs.c" "intel386.h"
      "mem-limits.h" "process.c" "template.h" "sysdep.c" "syssignal.h"
      "systty.h" "unexcoff.c" "linux.h")
     ;; No longer distributed.
@@ -421,7 +466,8 @@ Changes to files in this list are not listed.")
      "vt220.el" "vt240.el")
     ("Motorola" :changed "buff-menu.el")
     ("Hiroshi Nakano" :changed "ralloc.c")
-    ("Sundar Narasimhan" :changed "rnewspost.el")
+    ;; File removed in Emacs 24.1.
+;;;    ("Sundar Narasimhan" :changed "rnewspost.el")
     ;; No longer distributed.
 ;;;    ("NeXT, Inc." :wrote "unexnext.c")
     ("Mark Neale" :changed "fortran.el")
@@ -452,7 +498,7 @@ Changes to files in this list are not listed.")
     ("William Sommerfeld" :wrote "emacsclient.c" "scribe.el")
     ;; No longer distributed: emacsserver.c.
     ("Leigh Stoller" :changed "emacsclient.c" "server.el")
-    ("Steve Strassman" :wrote "spook.el")
+    ("Steve Strassmann" :wrote "spook.el")
     ("Shinichirou Sugou" :changed "etags.c")
     ;; No longer distributed: emacsserver.c.
     ("Sun Microsystems, Inc" :changed "emacsclient.c" "server.el"
@@ -532,8 +578,10 @@ in the repository.")
     ("w32console.c" . "w32term.c")
     ("unexnt.c" . "unexw32.c")
     ("s/windowsnt.h" . "s/ms-w32.h")
+    ("s/ms-w32.h" . "inc/ms-w32.h")
     ("winnt.el" . "w32-fns.el")
     ("config.emacs" . "configure")
+    ("configure.in" . "configure.ac")
     ("config.h.dist" . "config.in")
     ("config.h-dist" . "config.in")
     ("config.h.in" . "config.in")
@@ -587,6 +635,7 @@ in the repository.")
     ("texi/url.txi" . "url.texi")
     ("edt-user.doc" . "edt.texi")
     ("DEV-NOTES" . "nextstep")
+    ("org/COPYRIGHT-AND-LICENSE" . "org/README")
     ;; Moved to different directories.
     ("ctags.1" . "ctags.1")
     ("etags.1" . "etags.1")
@@ -655,7 +704,7 @@ or is on the list of removed files.  Returns the non-directory part of
 the file name.  Only uses the LOG-FILE position POS and associated AUTHOR
 to print a message if FILE is not found."
   ;; FILE should be re-checked in every different directory associated
-  ;; with a LOG-FILE.  Eg configure.in from src/ChangeLog is not the
+  ;; with a LOG-FILE.  Eg configure.ac from src/ChangeLog is not the
   ;; same as that from top-level/ChangeLog.
   (let* ((fullname (expand-file-name file (file-name-directory log-file)))
 	 (entry (assoc fullname authors-checked-files-alist))
@@ -783,7 +832,7 @@ with the file and the number of each action:
 	 (enable-local-eval nil)
 	 (existing-buffer (get-file-buffer log-file))
 	 (buffer (find-file-noselect log-file))
-	 authors file pos)
+	 authors pos)
     (with-current-buffer buffer
       (save-restriction
 	(widen)
@@ -897,8 +946,7 @@ and changed by AUTHOR."
 	       (file (car change))
 	       (filestat (if (authors-public-domain-p file)
 			     (concat file " (public domain)")
-			   file))
-	       slot)
+			   file)))
 	  (cond ((assq :wrote actions)
 		 (setq wrote-list (cons filestat wrote-list)))
 		((assq :cowrote actions)
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index 19a4d44273d..382e25f3121 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -1,6 +1,6 @@
-;; autoload.el --- maintain autoloads in loaddefs.el
+;; autoload.el --- maintain autoloads in loaddefs.el  -*- lexical-binding: t -*-
 
-;; Copyright (C) 1991-1997, 2001-2011  Free Software Foundation, Inc.
+;; Copyright (C) 1991-1997, 2001-2012  Free Software Foundation, Inc.
 
 ;; Author: Roland McGrath <roland@gnu.org>
 ;; Keywords: maint
@@ -32,7 +32,7 @@
 
 (require 'lisp-mode)			;for `doc-string-elt' properties.
 (require 'help-fns)			;for help-add-fundoc-usage.
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
 
 (defvar generated-autoload-file nil
   "File into which to write autoload definitions.
@@ -86,78 +86,100 @@ that text will be copied verbatim to `generated-autoload-file'.")
 
 (defvar autoload-modified-buffers)      ;Dynamically scoped var.
 
-(defun make-autoload (form file)
+(defun make-autoload (form file &optional expansion)
   "Turn FORM into an autoload or defvar for source file FILE.
 Returns nil if FORM is not a special autoload form (i.e. a function definition
-or macro definition or a defcustom)."
+or macro definition or a defcustom).
+If EXPANSION is non-nil, we're processing the macro expansion of an
+expression, in which case we want to handle forms differently."
   (let ((car (car-safe form)) expand)
     (cond
+     ((and expansion (eq car 'defalias))
+      (pcase-let*
+          ((`(,_ ,_ ,arg . ,rest) form)
+           ;; `type' is non-nil if it defines a macro.
+           ;; `fun' is the function part of `arg' (defaults to `arg').
+           ((or (and (or `(cons 'macro ,fun) `'(macro . ,fun)) (let type t))
+                (and (let fun arg) (let type nil)))
+            arg)
+           ;; `lam' is the lambda expression in `fun' (or nil if not
+           ;; recognized).
+           (lam (if (memq (car-safe fun) '(quote function)) (cadr fun)))
+           ;; `args' is the list of arguments (or t if not recognized).
+           ;; `body' is the body of `lam' (or t if not recognized).
+           ((or `(lambda ,args . ,body)
+                (and (let args t) (let body t)))
+            lam)
+           ;; Get the `doc' from `body' or `rest'.
+           (doc (cond ((stringp (car-safe body)) (car body))
+                      ((stringp (car-safe rest)) (car rest))))
+           ;; Look for an interactive spec.
+           (interactive (pcase body
+                          ((or `((interactive . ,_) . ,_)
+                               `(,_ (interactive . ,_) . ,_)) t))))
+        ;; Add the usage form at the end where describe-function-1
+        ;; can recover it.
+        (when (listp args) (setq doc (help-add-fundoc-usage doc args)))
+        ;; (message "autoload of %S" (nth 1 form))
+        `(autoload ,(nth 1 form) ,file ,doc ,interactive ,type)))
+
+     ((and expansion (memq car '(progn prog1)))
+      (let ((end (memq :autoload-end form)))
+	(when end             ;Cut-off anything after the :autoload-end marker.
+          (setq form (copy-sequence form))
+          (setcdr (memq :autoload-end form) nil))
+        (let ((exps (delq nil (mapcar (lambda (form)
+                                        (make-autoload form file expansion))
+                                      (cdr form)))))
+          (when exps (cons 'progn exps)))))
+
      ;; For complex cases, try again on the macro-expansion.
      ((and (memq car '(easy-mmode-define-global-mode define-global-minor-mode
-		       define-globalized-minor-mode
+                       define-globalized-minor-mode defun defmacro
+                       ;; FIXME: we'd want `defmacro*' here as well, so as
+                       ;; to handle its `declare', but when autoload is run
+                       ;; CL is not loaded so macroexpand doesn't know how
+                       ;; to expand it!
 		       easy-mmode-define-minor-mode define-minor-mode))
 	   (setq expand (let ((load-file-name file)) (macroexpand form)))
-	   (eq (car expand) 'progn)
-	   (memq :autoload-end expand))
-      (let ((end (memq :autoload-end expand)))
-	;; Cut-off anything after the :autoload-end marker.
-	(setcdr end nil)
-	(cons 'progn
-	      (mapcar (lambda (form) (make-autoload form file))
-		      (cdr expand)))))
+	   (memq (car expand) '(progn prog1 defalias)))
+      (make-autoload expand file 'expansion)) ;Recurse on the expansion.
 
      ;; For special function-like operators, use the `autoload' function.
-     ((memq car '(defun define-skeleton defmacro define-derived-mode
+     ((memq car '(define-skeleton define-derived-mode
                    define-compilation-mode define-generic-mode
 		   easy-mmode-define-global-mode define-global-minor-mode
 		   define-globalized-minor-mode
 		   easy-mmode-define-minor-mode define-minor-mode
-		   defun* defmacro* define-overloadable-function))
-      (let* ((macrop (memq car '(defmacro defmacro*)))
+		   cl-defun defun* cl-defmacro defmacro*
+                   define-overloadable-function))
+      (let* ((macrop (memq car '(defmacro cl-defmacro defmacro*)))
 	     (name (nth 1 form))
-	     (args (case car
-                     ((defun defmacro defun* defmacro*
-                        define-overloadable-function) (nth 2 form))
-                     ((define-skeleton) '(&optional str arg))
-                     ((define-generic-mode define-derived-mode
-                        define-compilation-mode) nil)
-                     (t)))
-	     (body (nthcdr (get car 'doc-string-elt) form))
+	     (args (pcase car
+                     ((or `defun `defmacro
+                          `defun* `defmacro* `cl-defun `cl-defmacro
+                          `define-overloadable-function) (nth 2 form))
+                     (`define-skeleton '(&optional str arg))
+                     ((or `define-generic-mode `define-derived-mode
+                          `define-compilation-mode) nil)
+                     (_ t)))
+	     (body (nthcdr (or (function-get car 'doc-string-elt) 3) form))
 	     (doc (if (stringp (car body)) (pop body))))
-	(when (listp args)
-	  ;; Add the usage form at the end where describe-function-1
-	  ;; can recover it.
-	  (setq doc (help-add-fundoc-usage doc args)))
-        (let ((exp
-               ;; `define-generic-mode' quotes the name, so take care of that
-               (list 'autoload (if (listp name) name (list 'quote name))
-                     file doc
-                     (or (and (memq car '(define-skeleton define-derived-mode
-                                           define-generic-mode
-                                           easy-mmode-define-global-mode
-                                           define-global-minor-mode
-                                           define-globalized-minor-mode
-                                           easy-mmode-define-minor-mode
-                                           define-minor-mode)) t)
-                         (eq (car-safe (car body)) 'interactive))
-                     (if macrop (list 'quote 'macro) nil))))
-          (when macrop
-            ;; Special case to autoload some of the macro's declarations.
-            (let ((decls (nth (if (stringp (nth 3 form)) 4 3) form))
-                  (exps '()))
-              (when (eq (car-safe decls) 'declare)
-                ;; FIXME: We'd like to reuse macro-declaration-function,
-                ;; but we can't since it doesn't return anything.
-                (dolist (decl decls)
-                  (case (car-safe decl)
-                    (indent
-                     (push `(put ',name 'lisp-indent-function ',(cadr decl))
-                           exps))
-                    (doc-string
-                     (push `(put ',name 'doc-string-elt ',(cadr decl)) exps))))
-                (when exps
-                  (setq exp `(progn ,exp ,@exps))))))
-          exp)))
+        ;; Add the usage form at the end where describe-function-1
+        ;; can recover it.
+	(when (listp args) (setq doc (help-add-fundoc-usage doc args)))
+        ;; `define-generic-mode' quotes the name, so take care of that
+        `(autoload ,(if (listp name) name (list 'quote name))
+           ,file ,doc
+           ,(or (and (memq car '(define-skeleton define-derived-mode
+                                  define-generic-mode
+                                  easy-mmode-define-global-mode
+                                  define-global-minor-mode
+                                  define-globalized-minor-mode
+                                  easy-mmode-define-minor-mode
+                                  define-minor-mode)) t)
+                (eq (car-safe (car body)) 'interactive))
+           ,(if macrop ''macro nil))))
 
      ;; For defclass forms, use `eieio-defclass-autoload'.
      ((eq car 'defclass)
@@ -190,6 +212,11 @@ or macro definition or a defcustom)."
            (if (member ',file loads) nil
              (put ',groupname 'custom-loads (cons ',file loads))))))
 
+     ;; When processing a macro expansion, any expression
+     ;; before a :autoload-end should be included.  These are typically (put
+     ;; 'fun 'prop val) and things like that.
+     ((and expansion (consp form)) form)
+
      ;; nil here indicates that this is not a special autoload form.
      (t nil))))
 
@@ -201,7 +228,8 @@ or macro definition or a defcustom)."
 (defun autoload-find-generated-file ()
   "Visit the autoload file for the current buffer, and return its buffer.
 If a buffer is visiting the desired autoload file, return it."
-  (let ((enable-local-variables :safe))
+  (let ((enable-local-variables :safe)
+	(enable-local-eval nil))
     ;; We used to use `raw-text' to read this file, but this causes
     ;; problems when the file contains non-ASCII characters.
     (find-file-noselect
@@ -250,7 +278,7 @@ put the output in."
    ;; Symbols at the toplevel are meaningless.
    ((symbolp form) nil)
    (t
-    (let ((doc-string-elt (get (car-safe form) 'doc-string-elt))
+    (let ((doc-string-elt (function-get (car-safe form) 'doc-string-elt))
 	  (outbuf autoload-print-form-outbuf))
       (if (and doc-string-elt (stringp (nth doc-string-elt form)))
 	  ;; We need to hack the printing because the
@@ -329,7 +357,7 @@ not be relied upon."
   "Insert the section-header line,
 which lists the file name and which functions are in it, etc."
   (insert generate-autoload-section-header)
-  (prin1 (list 'autoloads autoloads load-name file time)
+  (prin1 `(autoloads ,autoloads ,load-name ,file ,time)
 	 outbuf)
   (terpri outbuf)
   ;; Break that line at spaces, to avoid very long lines.
@@ -355,7 +383,8 @@ which lists the file name and which functions are in it, etc."
     (emacs-lisp-mode)
     (setq default-directory (file-name-directory file))
     (insert-file-contents file nil)
-    (let ((enable-local-variables :safe))
+    (let ((enable-local-variables :safe)
+	  (enable-local-eval nil))
       (hack-local-variables))
     (current-buffer)))
 
@@ -481,7 +510,7 @@ Return non-nil if and only if FILE adds no autoloads to OUTFILE
                   (search-forward generate-autoload-cookie)
                   (skip-chars-forward " \t")
                   (if (eolp)
-                      (condition-case err
+                      (condition-case-unless-debug err
                           ;; Read the next form and make an autoload.
                           (let* ((form (prog1 (read (current-buffer))
                                          (or (bolp) (forward-line 1))))
@@ -521,7 +550,7 @@ Return non-nil if and only if FILE adds no autoloads to OUTFILE
                 (save-excursion
                   ;; Insert the section-header line which lists the file name
                   ;; and which functions are in it, etc.
-                  (assert (= ostart output-start))
+                  (cl-assert (= ostart output-start))
                   (goto-char output-start)
                   (let ((relfile (file-relative-name absfile)))
                     (autoload-insert-section-header
@@ -671,9 +700,9 @@ file binds `generated-autoload-file' as a file-local variable,
 write its autoloads into the specified file instead."
   (interactive "DUpdate autoloads from directory: ")
   (let* ((files-re (let ((tmp nil))
-		     (dolist (suf (get-load-suffixes)
-				  (concat "^[^=.].*" (regexp-opt tmp t) "\\'"))
-		       (unless (string-match "\\.elc" suf) (push suf tmp)))))
+		     (dolist (suf (get-load-suffixes))
+		       (unless (string-match "\\.elc" suf) (push suf tmp)))
+                     (concat "^[^=.].*" (regexp-opt tmp t) "\\'")))
 	 (files (apply 'nconc
 		       (mapcar (lambda (dir)
 				 (directory-files (expand-file-name dir)
@@ -762,9 +791,6 @@ write its autoloads into the specified file instead."
 (define-obsolete-function-alias 'update-autoloads-from-directories
     'update-directory-autoloads "22.1")
 
-(defvar autoload-make-program (or (getenv "MAKE") "make")
-  "Name of the make program in use during the Emacs build process.")
-
 ;;;###autoload
 (defun batch-update-autoloads ()
   "Update loaddefs.el autoloads in batch mode.
diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el
index bc1efc118ef..1f00677cd00 100644
--- a/lisp/emacs-lisp/avl-tree.el
+++ b/lisp/emacs-lisp/avl-tree.el
@@ -1,6 +1,6 @@
 ;;; avl-tree.el --- balanced binary trees, AVL-trees
 
-;; Copyright (C) 1995, 2007-2011  Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2007-2012  Free Software Foundation, Inc.
 
 ;; Author: Per Cederqvist <ceder@lysator.liu.se>
 ;;         Inge Wallin <inge@lysator.liu.se>
@@ -31,7 +31,7 @@
 ;; deleting, and retrieving data from an AVL tree containing n elements
 ;; is O(log n). It is somewhat more rigidly balanced than other
 ;; self-balancing binary trees (such as red-black trees and AA trees),
-;; making insertion slighty slower, deletion somewhat slower, and
+;; making insertion slightly slower, deletion somewhat slower, and
 ;; retrieval somewhat faster (the asymptotic scaling is of course the
 ;; same for all types). Thus it may be a good choice when the tree will
 ;; be relatively static, i.e. data will be retrieved more often than
@@ -260,7 +260,7 @@ Return t if the height of the tree has grown."
 	(opp (avl-tree--switch-dir dir))
 	;; direction 0,1 -> sign factor -1,+1
 	(sgn (avl-tree--dir-to-sign dir))
-        p1 p2 b2 result)
+        p1 p2 b2)
     (cond
      ((< (* sgn (avl-tree--node-balance br)) 0)
       (setf (avl-tree--node-balance br) 0)
@@ -295,9 +295,9 @@ Return t if the height of the tree has grown."
 	        (if (> (* sgn b2) 0) (- sgn) 0)
 	      (avl-tree--node-balance p1)
 	        (if (< (* sgn b2) 0) sgn 0)
-	      (avl-tree--node-branch node branch) p2
-	      (avl-tree--node-balance
-	       (avl-tree--node-branch node branch)) 0))
+                (avl-tree--node-branch node branch) p2))
+      (setf (avl-tree--node-balance
+             (avl-tree--node-branch node branch)) 0)
       nil))))
 
 (defun avl-tree--do-enter (cmpfun root branch data &optional updatefun)
@@ -339,6 +339,16 @@ inserted data."
 	(cons nil newdata))  ; return value
       ))))
 
+(defun avl-tree--check (tree)
+  "Check the tree's balance."
+  (avl-tree--check-node (avl-tree--root tree)))
+(defun avl-tree--check-node (node)
+  (if (null node) 0
+    (let ((dl (avl-tree--check-node (avl-tree--node-left node)))
+	  (dr (avl-tree--check-node (avl-tree--node-right node))))
+      (assert (= (- dr dl) (avl-tree--node-balance node)))
+      (1+ (max dl dr)))))
+
 ;; ----------------------------------------------------------------
 
 
diff --git a/lisp/emacs-lisp/backquote.el b/lisp/emacs-lisp/backquote.el
index 34e316b2e48..870127ceac8 100644
--- a/lisp/emacs-lisp/backquote.el
+++ b/lisp/emacs-lisp/backquote.el
@@ -1,6 +1,6 @@
 ;;; backquote.el --- implement the ` Lisp construct
 
-;; Copyright (C) 1990, 1992, 1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1990, 1992, 1994, 2001-2012 Free Software Foundation, Inc.
 
 ;; Author: Rick Sladkey <jrs@world.std.com>
 ;; Maintainer: FSF
diff --git a/lisp/emacs-lisp/benchmark.el b/lisp/emacs-lisp/benchmark.el
index aa84a075b76..9029c81f279 100644
--- a/lisp/emacs-lisp/benchmark.el
+++ b/lisp/emacs-lisp/benchmark.el
@@ -1,6 +1,6 @@
 ;;; benchmark.el --- support for benchmarking code
 
-;; Copyright (C) 2003-2011  Free Software Foundation, Inc.
+;; Copyright (C) 2003-2012  Free Software Foundation, Inc.
 
 ;; Author: Dave Love  <fx@gnu.org>
 ;; Keywords: lisp, extensions
@@ -53,6 +53,7 @@ FORMS once.
 Return a list of the total elapsed time for execution, the number of
 garbage collections that ran, and the time taken by garbage collection.
 See also `benchmark-run-compiled'."
+  (declare (indent 1) (debug t))
   (unless (natnump repetitions)
     (setq forms (cons repetitions forms)
 	  repetitions 1))
@@ -69,8 +70,6 @@ See also `benchmark-run-compiled'."
 		`(benchmark-elapse ,@forms))
 	     (- gcs-done ,gcs)
 	     (- gc-elapsed ,gc)))))
-(put 'benchmark-run 'edebug-form-spec t)
-(put 'benchmark-run 'lisp-indent-function 2)
 
 ;;;###autoload
 (defmacro benchmark-run-compiled (&optional repetitions &rest forms)
@@ -78,6 +77,7 @@ See also `benchmark-run-compiled'."
 This is like `benchmark-run', but what is timed is a funcall of the
 byte code obtained by wrapping FORMS in a `lambda' and compiling the
 result.  The overhead of the `lambda's is accounted for."
+  (declare (indent 1) (debug t))
   (unless (natnump repetitions)
     (setq forms (cons repetitions forms)
 	  repetitions 1))
@@ -96,8 +96,6 @@ result.  The overhead of the `lambda's is accounted for."
 					  (funcall ,lambda-code))))
 		`(benchmark-elapse (funcall ,code)))
 	     (- gcs-done ,gcs) (- gc-elapsed ,gc)))))
-(put 'benchmark-run-compiled 'edebug-form-spec t)
-(put 'benchmark-run-compiled 'lisp-indent-function 2)
 
 ;;;###autoload
 (defun benchmark (repetitions form)
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index fd98b5f41a7..03d55f376af 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -1,6 +1,6 @@
 ;;; bindat.el --- binary data structure packing and unpacking.
 
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
 
 ;; Author: Kim F. Storm <storm@cua.dk>
 ;; Assignment name: struct.el
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index c9027fb663d..07e95e7e4cd 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -1,6 +1,6 @@
 ;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler -*- lexical-binding: t -*-
 
-;; Copyright (C) 1991, 1994, 2000-2011  Free Software Foundation, Inc.
+;; Copyright (C) 1991, 1994, 2000-2012  Free Software Foundation, Inc.
 
 ;; Author: Jamie Zawinski <jwz@lucid.com>
 ;;	Hallvard Furuseth <hbf@ulrik.uio.no>
@@ -183,7 +183,8 @@
 ;;; Code:
 
 (require 'bytecomp)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
+(require 'macroexp)
 
 (defun byte-compile-log-lap-1 (format &rest args)
   ;; Newer byte codes for stack-ref make the slot 0 non-nil again.
@@ -248,8 +249,8 @@
   (let* ((name (car form))
          (localfn (cdr (assq name byte-compile-function-environment)))
 	 (fn (or localfn (and (fboundp name) (symbol-function name)))))
-    (when (and (consp fn) (eq (car fn) 'autoload))
-      (load (nth 1 fn))
+    (when (autoloadp fn)
+      (autoload-do-load fn)
       (setq fn (or (and (fboundp name) (symbol-function name))
                    (cdr (assq name byte-compile-function-environment)))))
     (pcase fn
@@ -265,38 +266,30 @@
        ;; (message "Inlining byte-code for %S!" name)
        ;; The byte-code will be really inlined in byte-compile-unfold-bcf.
        `(,fn ,@(cdr form)))
-      ((or (and `(lambda ,args . ,body) (let env nil))
-           `(closure ,env ,args . ,body))
+      ((or `(lambda . ,_) `(closure . ,_))
        (if (not (or (eq fn localfn)     ;From the same file => same mode.
-                    (eq (not lexical-binding) (not env)))) ;Same mode.
+                    (eq (car fn)        ;Same mode.
+                        (if lexical-binding 'closure 'lambda))))
            ;; While byte-compile-unfold-bcf can inline dynbind byte-code into
            ;; letbind byte-code (or any other combination for that matter), we
            ;; can only inline dynbind source into dynbind source or letbind
            ;; source into letbind source.
-           ;; FIXME: we could of course byte-compile the inlined function
-           ;; first, and then inline its byte-code.
-           form
-         (let ((renv ()))
-           ;; Turn the function's closed vars (if any) into local let bindings.
-           (dolist (binding env)
-             (cond
-              ((consp binding)
-               ;; We check shadowing by the args, so that the `let' can be
-               ;; moved within the lambda, which can then be unfolded.
-               ;; FIXME: Some of those bindings might be unused in `body'.
-               (unless (memq (car binding) args) ;Shadowed.
-                 (push `(,(car binding) ',(cdr binding)) renv)))
-              ((eq binding t))
-              (t (push `(defvar ,binding) body))))
-           (let ((newfn (byte-compile-preprocess
-                         (if (null renv)
-                             `(lambda ,args ,@body)
-                           `(lambda ,args (let ,(nreverse renv) ,@body))))))
-             (if (eq (car-safe newfn) 'function)
-                 (byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form)))
-               (byte-compile-log-warning
-                (format "Inlining closure %S failed" name))
-               form)))))
+           (progn
+             ;; We can of course byte-compile the inlined function
+             ;; first, and then inline its byte-code.
+             (byte-compile name)
+             `(,(symbol-function name) ,@(cdr form)))
+         (let ((newfn (if (eq fn localfn)
+                          ;; If `fn' is from the same file, it has already
+                          ;; been preprocessed!
+                          `(function ,fn)
+                        (byte-compile-preprocess
+                         (byte-compile--reify-function fn)))))
+           (if (eq (car-safe newfn) 'function)
+               (byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form)))
+             (byte-compile-log-warning
+              (format "Inlining closure %S failed" name))
+             form))))
 
       (t ;; Give up on inlining.
        form))))
@@ -430,11 +423,9 @@
 			      clause))
 			 (cdr form))))
 	  ((eq fn 'progn)
-	   ;; as an extra added bonus, this simplifies (progn <x>) --> <x>
+	   ;; 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)))
+               (macroexp-progn (byte-optimize-body (cdr form) for-effect))
 	     (byte-optimize-form (nth 1 form) for-effect)))
 	  ((eq fn 'prog1)
 	   (if (cdr (cdr form))
@@ -496,7 +487,7 @@
 			      (prin1-to-string form))
 	   nil)
 
-	  ((memq fn '(defun defmacro function condition-case))
+	  ((memq fn '(function condition-case))
 	   ;; These forms are compiled as constants or by breaking out
 	   ;; all the subexpressions and compiling them separately.
 	   form)
@@ -573,10 +564,10 @@
 	       (cons fn args)))))))
 
 (defun byte-optimize-all-constp (list)
-  "Non-nil if all elements of LIST satisfy `byte-compile-constp'."
+  "Non-nil if all elements of LIST satisfy `macroexp-const-p"
   (let ((constant t))
     (while (and list constant)
-      (unless (byte-compile-constp (car list))
+      (unless (macroexp-const-p (car list))
 	(setq constant nil))
       (setq list (cdr list)))
     constant))
@@ -595,10 +586,11 @@
   (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)))
+	     (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 (function-get (car form) 'byte-optimizer)))
 	     (not (eq form (setq new (funcall opt form)))))
 	(progn
 ;;	  (if (equal form new) (error "bogus optimizer -- %s" opt))
@@ -639,10 +631,10 @@
   (while (eq (car-safe form) 'progn)
     (setq form (car (last (cdr form)))))
   (cond ((consp form)
-         (case (car form)
-           (quote (cadr form))
+         (pcase (car form)
+           (`quote (cadr form))
            ;; Can't use recursion in a defsubst.
-           ;; (progn (byte-compile-trueconstp (car (last (cdr form)))))
+           ;; (`progn (byte-compile-trueconstp (car (last (cdr form)))))
            ))
         ((not (symbolp form)))
         ((eq form t))
@@ -653,10 +645,10 @@
   (while (eq (car-safe form) 'progn)
     (setq form (car (last (cdr form)))))
   (cond ((consp form)
-         (case (car form)
-           (quote (null (cadr form)))
+         (pcase (car form)
+           (`quote (null (cadr form)))
            ;; Can't use recursion in a defsubst.
-           ;; (progn (byte-compile-nilconstp (car (last (cdr form)))))
+           ;; (`progn (byte-compile-nilconstp (car (last (cdr form)))))
            ))
         ((not (symbolp form)) nil)
         ((null form))))
@@ -866,8 +858,8 @@
 
 
 (defun byte-optimize-binary-predicate (form)
-  (if (byte-compile-constp (nth 1 form))
-      (if (byte-compile-constp (nth 2 form))
+  (if (macroexp-const-p (nth 1 form))
+      (if (macroexp-const-p (nth 2 form))
 	  (condition-case ()
 	      (list 'quote (eval form))
 	    (error form))
@@ -879,7 +871,7 @@
   (let ((ok t)
 	(rest (cdr form)))
     (while (and rest ok)
-      (setq ok (byte-compile-constp (car rest))
+      (setq ok (macroexp-const-p (car rest))
 	    rest (cdr rest)))
     (if ok
 	(condition-case ()
@@ -945,7 +937,7 @@
 (defun byte-optimize-quote (form)
   (if (or (consp (nth 1 form))
 	  (and (symbolp (nth 1 form))
-	       (not (byte-compile-const-symbol-p form))))
+	       (not (macroexp--const-symbol-p form))))
       form
     (nth 1 form)))
 
@@ -1155,16 +1147,6 @@
 ;; optimize string-as-unibyte, string-as-multibyte, string-make-unibyte,
 ;; string-make-multibyte for constant args.
 
-(put 'featurep 'byte-optimizer 'byte-optimize-featurep)
-(defun byte-optimize-featurep (form)
-  ;; Emacs-21's byte-code doesn't run under XEmacs or SXEmacs anyway, so we
-  ;; can safely optimize away this test.
-  (if (member (cdr-safe form) '(((quote xemacs)) ((quote sxemacs))))
-      nil
-    (if (member (cdr-safe form) '(((quote emacs))))
-	t
-      form)))
-
 (put 'set 'byte-optimizer 'byte-optimize-set)
 (defun byte-optimize-set (form)
   (let ((var (car-safe (cdr-safe form))))
@@ -1205,8 +1187,8 @@
 	 boundp buffer-file-name buffer-local-variables buffer-modified-p
 	 buffer-substring byte-code-function-p
 	 capitalize car-less-than-car car cdr ceiling char-after char-before
-	 char-equal char-to-string char-width
-	 compare-strings concat coordinates-in-window-p
+	 char-equal char-to-string char-width compare-strings
+	 compare-window-configurations concat coordinates-in-window-p
 	 copy-alist copy-sequence copy-marker cos count-lines
 	 decode-char
 	 decode-time default-boundp default-value documentation downcase
@@ -1214,17 +1196,18 @@
 	 fboundp fceiling featurep ffloor
 	 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 float-time floor format format-time-string frame-visible-p
-	 fround ftruncate
+	 float float-time floor format format-time-string frame-first-window
+	 frame-root-window frame-selected-window
+	 frame-visible-p fround ftruncate
 	 get gethash get-buffer get-buffer-window getenv get-file-buffer
 	 hash-table-count
 	 int-to-string intern-soft
 	 keymap-parent
 	 length local-variable-if-set-p local-variable-p log log10 logand
 	 logb logior lognot logxor lsh langinfo
-	 make-list make-string make-symbol
-	 marker-buffer max member memq min mod multibyte-char-to-unibyte
-	 next-window nth nthcdr number-to-string
+	 make-list make-string make-symbol marker-buffer max member memq min
+	 minibuffer-selected-window minibuffer-window
+	 mod multibyte-char-to-unibyte next-window nth nthcdr number-to-string
 	 parse-colon-path plist-get plist-member
 	 prefix-numeric-value previous-window prin1-to-string propertize
 	 degrees-to-radians
@@ -1237,11 +1220,21 @@
 	 string-to-multibyte
 	 tan truncate
 	 unibyte-char-to-multibyte upcase user-full-name
-	 user-login-name user-original-login-name user-variable-p
+	 user-login-name user-original-login-name custom-variable-p
 	 vconcat
-	 window-buffer window-dedicated-p window-edges window-height
-	 window-hscroll window-minibuffer-p window-width
-	 zerop))
+	 window-absolute-pixel-edges window-at window-body-height
+	 window-body-width window-buffer window-dedicated-p window-display-table
+	 window-combination-limit window-edges window-frame window-fringes
+	 window-height window-hscroll window-inside-edges
+	 window-inside-absolute-pixel-edges window-inside-pixel-edges
+	 window-left-child window-left-column window-margins window-minibuffer-p
+	 window-next-buffers window-next-sibling window-new-normal
+	 window-new-total window-normal-size window-parameter window-parameters
+	 window-parent window-pixel-edges window-point window-prev-buffers 
+	 window-prev-sibling window-redisplay-end-trigger window-scroll-bars
+	 window-start window-text-height window-top-child window-top-line
+	 window-total-height window-total-width window-use-time window-vscroll
+	 window-width zerop))
       (side-effect-and-error-free-fns
        '(arrayp atom
 	 bobp bolp bool-vector-p
@@ -1274,7 +1267,8 @@
 	 this-single-command-raw-keys
 	 user-real-login-name user-real-uid user-uid
 	 vector vectorp visible-frame-list
-	 wholenump window-configuration-p window-live-p windowp)))
+	 wholenump window-configuration-p window-live-p
+	 window-valid-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)))
@@ -1373,7 +1367,7 @@
             ;; This uses dynamic-scope magic.
             offset (disassemble-offset bytes))
       (let ((opcode (aref byte-code-vector bytedecomp-op)))
-	(assert opcode)
+	(cl-assert opcode)
 	(setq bytedecomp-op opcode))
       (cond ((memq bytedecomp-op byte-goto-ops)
 	     ;; It's a pc.
@@ -1574,7 +1568,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
               ;;   stack-set-X+1 stack-ref-X  -->  dup stack-set-X+2
               ;; but this is a very minor gain, since dup is stack-ref-0,
               ;; i.e. it's only better if X>5, and even then it comes
-              ;; at the cost cost of an extra stack slot.  Let's not bother.
+              ;; at the cost of an extra stack slot.  Let's not bother.
 	      ((and (eq 'byte-varref (car lap2))
                     (eq (cdr lap1) (cdr lap2))
                     (memq (car lap1) '(byte-varset byte-varbind)))
@@ -1582,13 +1576,13 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
 			(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)
-					 (byte-compile-const-symbol-p
-					  (car (cdr lap0))))
-				     (cdr lap0)
-				   (byte-compile-get-constant t)))
+                 (if (memq (car lap0) '(byte-constant byte-dup))
+                     (progn
+                       (setq tmp (if (or (not tmp)
+                                         (macroexp--const-symbol-p
+                                          (car (cdr lap0))))
+                                     (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))
@@ -1616,7 +1610,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
 	       (byte-compile-log-lap "  dup %s discard\t-->\t%s" lap1 lap1)
 	       (setq keep-going t
 		     rest (cdr rest))
-               (if (eq 'byte-stack-set (car lap1)) (decf (cdr lap1)))
+               (if (eq 'byte-stack-set (car lap1)) (cl-decf (cdr lap1)))
 	       (setq lap (delq lap0 (delq lap2 lap))))
 	      ;;
 	      ;; not goto-X-if-nil              -->  goto-X-if-non-nil
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index f79add14836..b4582a41d6c 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -1,6 +1,6 @@
-;;; byte-run.el --- byte-compiler support for inlining
+;;; byte-run.el --- byte-compiler support for inlining  -*- lexical-binding: t -*-
 
-;; Copyright (C) 1992, 2001-2011  Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2012  Free Software Foundation, Inc.
 
 ;; Author: Jamie Zawinski <jwz@lucid.com>
 ;;	Hallvard Furuseth <hbf@ulrik.uio.no>
@@ -30,37 +30,181 @@
 
 ;;; Code:
 
-;; We define macro-declaration-function here because it is needed to
-;; handle declarations in macro definitions and this is the first file
-;; loaded by loadup.el that uses declarations in macros.
+;; `macro-declaration-function' are both obsolete (as marked at the end of this
+;; file) but used in many .elc files.
+
+(defvar macro-declaration-function #'macro-declaration-function
+  "Function to process declarations in a macro definition.
+The function will be called with two args MACRO and DECL.
+MACRO is the name of the macro being defined.
+DECL is a list `(declare ...)' containing the declarations.
+The value the function returns is not used.")
 
-(defun macro-declaration-function (macro decl)
-  "Process a declaration found in a macro definition.
+(defalias 'macro-declaration-function
+  #'(lambda (macro decl)
+      "Process a declaration found in a macro definition.
 This is set as the value of the variable `macro-declaration-function'.
 MACRO is the name of the macro being defined.
 DECL is a list `(declare ...)' containing the declarations.
 The return value of this function is not used."
-  ;; We can't use `dolist' or `cadr' yet for bootstrapping reasons.
-  (let (d)
-    ;; Ignore the first element of `decl' (it's always `declare').
-    (while (setq decl (cdr decl))
-      (setq d (car decl))
-      (if (and (consp d)
-	       (listp (cdr d))
-	       (null (cdr (cdr d))))
-	  (cond ((eq (car d) 'indent)
-		 (put macro 'lisp-indent-function (car (cdr d))))
-		((eq (car d) 'debug)
-		 (put macro 'edebug-form-spec (car (cdr d))))
-		((eq (car d) 'doc-string)
-		 (put macro 'doc-string-elt (car (cdr d))))
-		(t
-		 (message "Unknown declaration %s" d)))
-	(message "Invalid declaration %s" d)))))
-
-
-(setq macro-declaration-function 'macro-declaration-function)
+      ;; We can't use `dolist' or `cadr' yet for bootstrapping reasons.
+      (let (d)
+        ;; Ignore the first element of `decl' (it's always `declare').
+        (while (setq decl (cdr decl))
+          (setq d (car decl))
+          (if (and (consp d)
+                   (listp (cdr d))
+                   (null (cdr (cdr d))))
+              (cond ((eq (car d) 'indent)
+                     (put macro 'lisp-indent-function (car (cdr d))))
+                    ((eq (car d) 'debug)
+                     (put macro 'edebug-form-spec (car (cdr d))))
+                    ((eq (car d) 'doc-string)
+                     (put macro 'doc-string-elt (car (cdr d))))
+                    (t
+                     (message "Unknown declaration %s" d)))
+            (message "Invalid declaration %s" d))))))
+
+;; We define macro-declaration-alist here because it is needed to
+;; handle declarations in macro definitions and this is the first file
+;; loaded by loadup.el that uses declarations in macros.
 
+(defvar defun-declarations-alist
+  (list
+   ;; We can only use backquotes inside the lambdas and not for those
+   ;; properties that are used by functions loaded before backquote.el.
+   (list 'advertised-calling-convention
+         #'(lambda (f _args arglist when)
+             (list 'set-advertised-calling-convention
+                   (list 'quote f) (list 'quote arglist) (list 'quote when))))
+   (list 'obsolete
+         #'(lambda (f _args new-name when)
+             `(make-obsolete ',f ',new-name ,when)))
+   (list 'compiler-macro
+         #'(lambda (f args compiler-function)
+             ;; FIXME: Make it possible to just reuse `args'.
+             `(eval-and-compile
+                (put ',f 'compiler-macro
+                     ,(if (eq (car-safe compiler-function) 'lambda)
+                          `(lambda ,(append (cadr compiler-function) args)
+                             ,@(cddr compiler-function))
+                        `#',compiler-function)))))
+   (list 'doc-string
+         #'(lambda (f _args pos)
+             (list 'put (list 'quote f) ''doc-string-elt (list 'quote pos))))
+   (list 'indent
+         #'(lambda (f _args val)
+             (list 'put (list 'quote f)
+                   ''lisp-indent-function (list 'quote val)))))
+  "List associating function properties to their macro expansion.
+Each element of the list takes the form (PROP FUN) where FUN is
+a function.  For each (PROP . VALUES) in a function's declaration,
+the FUN corresponding to PROP is called with the function name,
+the function's arglist, and the VALUES and should return the code to use
+to set this property.")
+
+(defvar macro-declarations-alist
+  (cons
+   (list 'debug
+         #'(lambda (name _args spec)
+             (list 'progn :autoload-end
+                   (list 'put (list 'quote name)
+                         ''edebug-form-spec (list 'quote spec)))))
+   defun-declarations-alist)
+  "List associating properties of macros to their macro expansion.
+Each element of the list takes the form (PROP FUN) where FUN is
+a function.  For each (PROP . VALUES) in a macro's declaration,
+the FUN corresponding to PROP is called with the function name
+and the VALUES and should return the code to use to set this property.")
+
+(put 'defmacro 'doc-string-elt 3)
+(defalias 'defmacro
+  (cons
+   'macro
+   #'(lambda (name arglist &optional docstring decl &rest body)
+       "Define NAME as a macro.
+When the macro is called, as in (NAME ARGS...),
+the function (lambda ARGLIST BODY...) is applied to
+the list ARGS... as it appears in the expression,
+and the result should be a form to be evaluated instead of the original.
+DECL is a declaration, optional, of the form (declare DECLS...) where
+DECLS is a list of elements of the form (PROP . VALUES).  These are
+interpreted according to `macro-declarations-alist'.
+The return value is undefined."
+       (if (stringp docstring) nil
+         (if decl (setq body (cons decl body)))
+         (setq decl docstring)
+         (setq docstring nil))
+       (if (or (null decl) (eq 'declare (car-safe decl))) nil
+         (setq body (cons decl body))
+         (setq decl nil))
+       (if (null body) (setq body '(nil)))
+       (if docstring (setq body (cons docstring body)))
+       ;; Can't use backquote because it's not defined yet!
+       (let* ((fun (list 'function (cons 'lambda (cons arglist body))))
+              (def (list 'defalias
+                         (list 'quote name)
+                         (list 'cons ''macro fun)))
+              (declarations
+               (mapcar
+                #'(lambda (x)
+                    (let ((f (cdr (assq (car x) macro-declarations-alist))))
+                      (if f (apply (car f) name arglist (cdr x))
+                        (message "Warning: Unknown macro property %S in %S"
+                                 (car x) name))))
+                (cdr decl))))
+         (if declarations
+             (cons 'prog1 (cons def declarations))
+           def)))))
+
+;; Now that we defined defmacro we can use it!
+(defmacro defun (name arglist &optional docstring &rest body)
+  "Define NAME as a function.
+The definition is (lambda ARGLIST [DOCSTRING] BODY...).
+See also the function `interactive'.
+DECL is a declaration, optional, of the form (declare DECLS...) where
+DECLS is a list of elements of the form (PROP . VALUES).  These are
+interpreted according to `defun-declarations-alist'.
+The return value is undefined.
+
+\(fn NAME ARGLIST &optional DOCSTRING DECL &rest BODY)"
+  ;; We can't just have `decl' as an &optional argument, because we need
+  ;; to distinguish
+  ;;    (defun foo (arg) (toto) nil)
+  ;; from
+  ;;    (defun foo (arg) (toto)).
+  (declare (doc-string 3))
+  (let ((decls (cond
+                ((eq (car-safe docstring) 'declare)
+                 (prog1 (cdr docstring) (setq docstring nil)))
+                ((eq (car-safe (car body)) 'declare)
+                 (prog1 (cdr (car body)) (setq body (cdr body)))))))
+    (if docstring (setq body (cons docstring body))
+      (if (null body) (setq body '(nil))))
+    (let ((declarations
+           (mapcar
+            #'(lambda (x)
+                (let ((f (cdr (assq (car x) defun-declarations-alist))))
+                  (cond
+                   (f (apply (car f) name arglist (cdr x)))
+                   ;; Yuck!!
+                   ((and (featurep 'cl)
+                         (memq (car x)  ;C.f. cl-do-proclaim.
+                               '(special inline notinline optimize warn)))
+                    (push (list 'declare x)
+                          (if (stringp docstring) (cdr body) body))
+                    nil)
+                   (t (message "Warning: Unknown defun property `%S' in %S"
+                               (car x) name)))))
+                   decls))
+          (def (list 'defalias
+                     (list 'quote name)
+                     (list 'function
+                           (cons 'lambda
+                                 (cons arglist body))))))
+      (if declarations
+          (cons 'prog1 (cons def declarations))
+        def))))
 
 ;; Redefined in byte-optimize.el.
 ;; This is not documented--it's not clear that we should promote it.
@@ -93,10 +237,10 @@ The return value of this function is not used."
 ;; 			 (list 'put x ''byte-optimizer nil)))
 ;; 		fns)))
 
-;; This has a special byte-hunk-handler in bytecomp.el.
 (defmacro defsubst (name arglist &rest body)
-  "Define an inline function.  The syntax is just like that of `defun'."
-  (declare (debug defun))
+  "Define an inline function.  The syntax is just like that of `defun'.
+\(fn NAME ARGLIST &optional DOCSTRING DECL &rest BODY)"
+  (declare (debug defun) (doc-string 3))
   (or (memq (get name 'byte-optimizer)
 	    '(nil byte-compile-inline-expand))
       (error "`%s' is a primitive" name))
@@ -107,7 +251,7 @@ The return value of this function is not used."
 
 (defvar advertised-signature-table (make-hash-table :test 'eq :weakness 'key))
 
-(defun set-advertised-calling-convention (function signature when)
+(defun set-advertised-calling-convention (function signature _when)
   "Set the advertised SIGNATURE of FUNCTION.
 This will allow the byte-compiler to warn the programmer when she uses
 an obsolete calling convention.  WHEN specifies since when the calling
@@ -116,21 +260,23 @@ convention was modified."
            advertised-signature-table))
 
 (defun make-obsolete (obsolete-name current-name &optional when)
-  "Make the byte-compiler warn that OBSOLETE-NAME is obsolete.
+  "Make the byte-compiler warn that function OBSOLETE-NAME is obsolete.
+OBSOLETE-NAME should be a function name or macro name (a symbol).
+
 The warning will say that CURRENT-NAME should be used instead.
 If CURRENT-NAME is a string, that is the `use instead' message
 \(it should end with a period, and not start with a capital).
 WHEN should be a string indicating when the function
 was first made obsolete, for example a date or a release number."
+  (declare (advertised-calling-convention
+            ;; New code should always provide the `when' argument.
+            (obsolete-name current-name when) "23.1"))
   (interactive "aMake function obsolete: \nxObsoletion replacement: ")
   (put obsolete-name 'byte-obsolete-info
        ;; The second entry used to hold the `byte-compile' handler, but
        ;; is not used any more nowadays.
        (purecopy (list current-name nil when)))
   obsolete-name)
-(set-advertised-calling-convention
- ;; New code should always provide the `when' argument.
- 'make-obsolete '(obsolete-name current-name when) "23.1")
 
 (defmacro define-obsolete-function-alias (obsolete-name current-name
 						   &optional when docstring)
@@ -144,14 +290,13 @@ is equivalent to the following two lines of code:
 \(make-obsolete 'old-fun 'new-fun \"22.1\")
 
 See the docstrings of `defalias' and `make-obsolete' for more details."
-  (declare (doc-string 4))
+  (declare (doc-string 4)
+           (advertised-calling-convention
+            ;; New code should always provide the `when' argument.
+            (obsolete-name current-name when &optional docstring) "23.1"))
   `(progn
      (defalias ,obsolete-name ,current-name ,docstring)
      (make-obsolete ,obsolete-name ,current-name ,when)))
-(set-advertised-calling-convention
- ;; New code should always provide the `when' argument.
- 'define-obsolete-function-alias
- '(obsolete-name current-name when &optional docstring) "23.1")
 
 (defun make-obsolete-variable (obsolete-name current-name &optional when access-type)
   "Make the byte-compiler warn that OBSOLETE-NAME is obsolete.
@@ -161,13 +306,13 @@ WHEN should be a string indicating when the variable
 was first made obsolete, for example a date or a release number.
 ACCESS-TYPE if non-nil should specify the kind of access that will trigger
   obsolescence warnings; it can be either `get' or `set'."
+  (declare (advertised-calling-convention
+            ;; New code should always provide the `when' argument.
+            (obsolete-name current-name when &optional access-type) "23.1"))
   (put obsolete-name 'byte-obsolete-variable
        (purecopy (list current-name access-type when)))
   obsolete-name)
-(set-advertised-calling-convention
- ;; New code should always provide the `when' argument.
- 'make-obsolete-variable
- '(obsolete-name current-name when &optional access-type) "23.1")
+
 
 (defmacro define-obsolete-variable-alias (obsolete-name current-name
 						 &optional when docstring)
@@ -176,7 +321,7 @@ This uses `defvaralias' and `make-obsolete-variable' (which see).
 See the Info node `(elisp)Variable Aliases' for more details.
 
 If CURRENT-NAME is a defcustom (more generally, any variable
-where OBSOLETE-NAME may be set, e.g. in a .emacs file, before the
+where OBSOLETE-NAME may be set, e.g. in an init file, before the
 alias is defined), then the define-obsolete-variable-alias
 statement should be evaluated before the defcustom, if user
 customizations are to be respected.  The simplest way to achieve
@@ -190,7 +335,10 @@ For the benefit of `custom-set-variables', if OBSOLETE-NAME has
 any of the following properties, they are copied to
 CURRENT-NAME, if it does not already have them:
 'saved-value, 'saved-variable-comment."
-  (declare (doc-string 4))
+  (declare (doc-string 4)
+           (advertised-calling-convention
+            ;; New code should always provide the `when' argument.
+            (obsolete-name current-name when &optional docstring) "23.1"))
   `(progn
      (defvaralias ,obsolete-name ,current-name ,docstring)
      ;; See Bug#4706.
@@ -199,10 +347,6 @@ CURRENT-NAME, if it does not already have them:
             (null (get ,current-name prop))
             (put ,current-name prop (get ,obsolete-name prop))))
      (make-obsolete-variable ,obsolete-name ,current-name ,when)))
-(set-advertised-calling-convention
- ;; New code should always provide the `when' argument.
- 'define-obsolete-variable-alias
- '(obsolete-name current-name when &optional docstring) "23.1")
 
 ;; FIXME This is only defined in this file because the variable- and
 ;; function- versions are too.  Unlike those two, this one is not used
@@ -283,4 +427,9 @@ In interpreted code, this is entirely equivalent to `progn'."
 ;;       (file-format emacs19))"
 ;;   nil)
 
+(make-obsolete-variable 'macro-declaration-function
+                        'macro-declarations-alist "24.3")
+(make-obsolete 'macro-declaration-function
+               'macro-declarations-alist "24.3")
+
 ;;; byte-run.el ends here
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 29c5f3f092b..5867cfb7064 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1,6 +1,6 @@
 ;;; bytecomp.el --- compilation of Lisp code into byte code -*- lexical-binding: t -*-
 
-;; Copyright (C) 1985-1987, 1992, 1994, 1998, 2000-2011
+;; Copyright (C) 1985-1987, 1992, 1994, 1998, 2000-2012
 ;;   Free Software Foundation, Inc.
 
 ;; Author: Jamie Zawinski <jwz@lucid.com>
@@ -120,7 +120,7 @@
 (require 'backquote)
 (require 'macroexp)
 (require 'cconv)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
 
 (or (fboundp 'defsubst)
     ;; This really ought to be loaded already!
@@ -355,7 +355,7 @@ else the global value will be modified."
 (defvar byte-compile-interactive-only-functions
   '(beginning-of-buffer end-of-buffer replace-string replace-regexp
     insert-file insert-buffer insert-file-literally previous-line next-line
-    goto-line comint-run delete-backward-char toggle-read-only)
+    goto-line comint-run delete-backward-char)
   "List of commands that are not meant to be called from Lisp.")
 
 (defvar byte-compile-not-obsolete-vars nil
@@ -419,8 +419,8 @@ This list lives partly on the stack.")
 
 (defconst byte-compile-initial-macro-environment
   '(
-;;     (byte-compiler-options . (lambda (&rest forms)
-;; 			       (apply 'byte-compiler-options-handler forms)))
+    ;; (byte-compiler-options . (lambda (&rest forms)
+    ;;     		       (apply 'byte-compiler-options-handler forms)))
     (declare-function . byte-compile-macroexpand-declare-function)
     (eval-when-compile . (lambda (&rest body)
 			   (list
@@ -429,8 +429,19 @@ This list lives partly on the stack.")
                              (byte-compile-top-level
                               (byte-compile-preprocess (cons 'progn body)))))))
     (eval-and-compile . (lambda (&rest body)
-			  (byte-compile-eval-before-compile (cons 'progn body))
-			  (cons 'progn body))))
+                          ;; Byte compile before running it.  Do it piece by
+                          ;; piece, in case further expressions need earlier
+                          ;; ones to be evaluated already, as is the case in
+                          ;; eieio.el.
+                          `(progn
+                             ,@(mapcar (lambda (exp)
+                                         (let ((cexp
+                                                (byte-compile-top-level
+                                                 (byte-compile-preprocess
+                                                  exp))))
+                                           (eval cexp)
+                                           cexp))
+                                       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.")
@@ -731,14 +742,16 @@ otherwise pop it")
 ;; Also, this lets us notice references to free variables.
 
 (defmacro byte-compile-push-bytecodes (&rest args)
-  "Push BYTE... onto BYTES, and increment PC by the number of bytes pushed.
-ARGS is of the form (BYTE... BYTES PC), where BYTES and PC are variable names.
-BYTES and PC are updated after evaluating all the arguments."
+  "Push bytes onto BVAR, and increment CVAR by the number of bytes pushed.
+BVAR and CVAR are variables which are updated after evaluating
+all the arguments.
+
+\(fn BYTE1 BYTE2 ... BYTEn BVAR CVAR)"
   (let ((byte-exprs (butlast args 2))
 	(bytes-var (car (last args 2)))
 	(pc-var (car (last args))))
     `(setq ,bytes-var ,(if (null (cdr byte-exprs))
-                           `(progn (assert (<= 0 ,(car byte-exprs)))
+                           `(progn (cl-assert (<= 0 ,(car byte-exprs)))
                                    (cons ,@byte-exprs ,bytes-var))
                          `(nconc (list ,@(reverse byte-exprs)) ,bytes-var))
            ,pc-var (+ ,(length byte-exprs) ,pc-var))))
@@ -846,7 +859,7 @@ CONST2 may be evaluated multiple times."
 (defun byte-compile-cl-file-p (file)
   "Return non-nil if FILE is one of the CL files."
   (and (stringp file)
-       (string-match "^cl\\>" (file-name-nondirectory file))))
+       (string-match "^cl\\.el" (file-name-nondirectory file))))
 
 (defun byte-compile-eval (form)
   "Eval FORM and mark the functions defined therein.
@@ -863,25 +876,14 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
 	    (let ((xs (pop hist-new))
 		  old-autoloads)
 	      ;; Make sure the file was not already loaded before.
-	      (unless (or (assoc (car xs) hist-orig)
-			  ;; Don't give both the "noruntime" and
-			  ;; "cl-functions" warning for the same function.
-			  ;; FIXME This seems incorrect - these are two
-			  ;; independent warnings.  For example, you may be
-			  ;; choosing to see the cl warnings but ignore them.
-			  ;; You probably don't want to ignore noruntime in the
-			  ;; same way.
-			  (and (byte-compile-warning-enabled-p 'cl-functions)
-			       (byte-compile-cl-file-p (car xs))))
+	      (unless (assoc (car xs) hist-orig)
 		(dolist (s xs)
 		  (cond
-		   ((symbolp s)
-		    (unless (memq s old-autoloads)
-		      (push s byte-compile-noruntime-functions)))
 		   ((and (consp s) (eq t (car s)))
 		    (push (cdr s) old-autoloads))
-		   ((and (consp s) (eq 'autoload (car s)))
-		    (push (cdr s) byte-compile-noruntime-functions)))))))
+		   ((and (consp s) (memq (car s) '(autoload defun)))
+		    (unless (memq (cdr s) old-autoloads)
+                      (push (cdr s) byte-compile-noruntime-functions))))))))
 	  ;; Go through current-load-list for the locally defined funs.
 	  (let (old-autoloads)
 	    (while (and hist-nil-new (not (eq hist-nil-new hist-nil-orig)))
@@ -1002,18 +1004,32 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
 
 (defvar byte-compile-last-warned-form nil)
 (defvar byte-compile-last-logged-file nil)
+(defvar byte-compile-root-dir nil
+  "Directory relative to which file names in error messages are written.")
+
+;; FIXME: We should maybe extend abbreviate-file-name with an optional DIR
+;; argument to try and use a relative file-name.
+(defun byte-compile-abbreviate-file (file &optional dir)
+  (let ((f1 (abbreviate-file-name file))
+        (f2 (file-relative-name file dir)))
+    (if (< (length f2) (length f1)) f2 f1)))
 
 ;; This is used as warning-prefix for the compiler.
 ;; It is always called with the warnings buffer current.
 (defun byte-compile-warning-prefix (level entry)
   (let* ((inhibit-read-only t)
-	 (dir default-directory)
+	 (dir (or byte-compile-root-dir default-directory))
 	 (file (cond ((stringp byte-compile-current-file)
-		      (format "%s:" (file-relative-name
+		      (format "%s:" (byte-compile-abbreviate-file
                                      byte-compile-current-file dir)))
 		     ((bufferp byte-compile-current-file)
 		      (format "Buffer %s:"
 			      (buffer-name byte-compile-current-file)))
+		     ;; We might be simply loading a file that
+		     ;; contains explicit calls to byte-compile functions.
+		     ((stringp load-file-name)
+		      (format "%s:" (byte-compile-abbreviate-file
+                                     load-file-name dir)))
 		     (t "")))
 	 (pos (if (and byte-compile-current-file
 		       (integerp byte-compile-read-position))
@@ -1094,8 +1110,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
 (defun byte-compile-log-warning (string &optional fill level)
   (let ((warning-prefix-function 'byte-compile-warning-prefix)
 	(warning-type-format "")
-	(warning-fill-prefix (if fill "    "))
-	(inhibit-read-only t))
+	(warning-fill-prefix (if fill "    ")))
     (display-warning 'bytecomp string level byte-compile-log-buffer)))
 
 (defun byte-compile-warn (format &rest args)
@@ -1109,18 +1124,12 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
   "Warn that SYMBOL (a variable or function) is obsolete."
   (when (byte-compile-warning-enabled-p 'obsolete)
     (let* ((funcp (get symbol 'byte-obsolete-info))
-	   (obsolete (or funcp (get symbol 'byte-obsolete-variable)))
-	   (instead (car obsolete))
-	   (asof (nth 2 obsolete)))
+           (msg (macroexp--obsolete-warning
+                 symbol
+                 (or funcp (get symbol 'byte-obsolete-variable))
+                 (if funcp "function" "variable"))))
       (unless (and funcp (memq symbol byte-compile-not-obsolete-funcs))
-	(byte-compile-warn "`%s' is an obsolete %s%s%s" symbol
-			   (if funcp "function" "variable")
-			   (if asof (concat " (as of " asof ")") "")
-			   (cond ((stringp instead)
-				  (concat "; " instead))
-				 (instead
-				  (format "; use `%s' instead." instead))
-				 (t ".")))))))
+	(byte-compile-warn "%s" msg)))))
 
 (defun byte-compile-report-error (error-info)
   "Report Lisp error in compilation.  ERROR-INFO is the error data."
@@ -1167,12 +1176,14 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
              (t fn)))))))
 
 (defun byte-compile-arglist-signature (arglist)
-  (if (integerp arglist)
-      ;; New style byte-code arglist.
-      (cons (logand arglist 127)             ;Mandatory.
-            (if (zerop (logand arglist 128)) ;No &rest.
-                (lsh arglist -8)))           ;Nonrest.
-    ;; Old style byte-code, or interpreted function.
+  (cond
+   ;; New style byte-code arglist.
+   ((integerp arglist)
+    (cons (logand arglist 127)             ;Mandatory.
+          (if (zerop (logand arglist 128)) ;No &rest.
+              (lsh arglist -8))))          ;Nonrest.
+   ;; Old style byte-code, or interpreted function.
+   ((listp arglist)
     (let ((args 0)
           opts
           restp)
@@ -1188,7 +1199,9 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
                    (setq opts (1+ opts))
 		 (setq args (1+ args)))))
         (setq arglist (cdr arglist)))
-      (cons args (if restp nil (if opts (+ args opts) args))))))
+      (cons args (if restp nil (if opts (+ args opts) args)))))
+   ;; Unknown arglist.
+   (t '(0))))
 
 
 (defun byte-compile-arglist-signatures-congruent-p (old new)
@@ -1248,8 +1261,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
     ;; and/or remember its arity if it's unknown.
     (or (and (or def (fboundp (car form))) ; might be a subr or autoload.
 	     (not (memq (car form) byte-compile-noruntime-functions)))
-	(eq (car form) byte-compile-current-form) ; ## this doesn't work
-					; with recursion.
+	(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))
@@ -1314,9 +1327,8 @@ extra args."
 
 ;; Warn if the function or macro is being redefined with a different
 ;; number of arguments.
-(defun byte-compile-arglist-warn (form macrop)
-  (let* ((name (nth 1 form))
-         (old (byte-compile-fdefinition name macrop))
+(defun byte-compile-arglist-warn (name arglist macrop)
+  (let* ((old (byte-compile-fdefinition name macrop))
          (initial (and macrop
                        (cdr (assq name
                                   byte-compile-initial-macro-environment)))))
@@ -1335,12 +1347,12 @@ extra args."
                          (`(closure ,_ ,args . ,_) args)
                          ((pred byte-code-function-p) (aref old 0))
                          (t '(&rest def)))))
-		(sig2 (byte-compile-arglist-signature (nth 2 form))))
+		(sig2 (byte-compile-arglist-signature arglist)))
 	    (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2)
 	      (byte-compile-set-symbol-position name)
 	      (byte-compile-warn
 	       "%s %s used to take %s %s, now takes %s"
-	       (if (eq (car form) 'defun) "function" "macro")
+	       (if macrop "macro" "function")
 	       name
 	       (byte-compile-arglist-signature-string sig1)
 	       (if (equal sig1 '(1 . 1)) "argument" "arguments")
@@ -1350,11 +1362,11 @@ extra args."
 	    nums sig min max)
 	(when calls
           (when (and (symbolp name)
-                     (eq (get name 'byte-optimizer)
+                     (eq (function-get name 'byte-optimizer)
                          'byte-compile-inline-expand))
             (byte-compile-warn "defsubst `%s' was used before it was defined"
 		       name))
-          (setq sig (byte-compile-arglist-signature (nth 2 form))
+          (setq sig (byte-compile-arglist-signature arglist)
                 nums (sort (copy-sequence (cdr calls)) (function <))
                 min (car nums)
                 max (car (nreverse nums)))
@@ -1394,18 +1406,18 @@ extra args."
 	     ;; These aren't all aliases of subrs, so not trivial to
 	     ;; avoid hardwiring the list.
 	     (not (memq func
-			'(cl-block-wrapper cl-block-throw
+			'(cl--block-wrapper cl--block-throw
 			  multiple-value-call nth-value
 			  copy-seq first second rest endp cl-member
 			  ;; These are included in generated code
 			  ;; that can't be called except at compile time
 			  ;; or unless cl is loaded anyway.
-			  cl-defsubst-expand cl-struct-setf-expander
+			  cl--defsubst-expand cl-struct-setf-expander
 			  ;; These would sometimes be warned about
 			  ;; but such warnings are never useful,
 			  ;; so don't warn about them.
 			  macroexpand cl-macroexpand-all
-			  cl-compiling-file))))
+			  cl--compiling-file))))
 	(byte-compile-warn "function `%s' from cl package called at runtime"
 			   func)))
   form)
@@ -1459,57 +1471,40 @@ extra args."
   nil)
 
 
-(defsubst byte-compile-const-symbol-p (symbol &optional any-value)
-  "Non-nil if SYMBOL is constant.
-If ANY-VALUE is nil, only return non-nil if the value of the symbol is the
-symbol itself."
-  (or (memq symbol '(nil t))
-      (keywordp symbol)
-      (if any-value
-	  (or (memq symbol byte-compile-const-variables)
-	      ;; FIXME: We should provide a less intrusive way to find out
-	      ;; if a variable is "constant".
-	      (and (boundp symbol)
-		   (condition-case nil
-		       (progn (set symbol (symbol-value symbol)) nil)
-		     (setting-constant t)))))))
-
-(defmacro byte-compile-constp (form)
-  "Return non-nil if FORM is a constant."
-  `(cond ((consp ,form) (eq (car ,form) 'quote))
-	 ((not (symbolp ,form)))
-	 ((byte-compile-const-symbol-p ,form))))
+;; Dynamically bound in byte-compile-from-buffer.
+;; NB also used in cl.el and cl-macs.el.
+(defvar byte-compile--outbuffer)
 
 (defmacro byte-compile-close-variables (&rest body)
   (declare (debug t))
-  (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-const-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-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 byte-compile-warnings)
-		)
-	      body)))
+  `(let (;;
+         ;; 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--outbuffer nil)
+         (byte-compile-function-environment nil)
+         (byte-compile-bound-variables nil)
+         (byte-compile-const-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-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 byte-compile-warnings)
+         )
+     ,@body))
 
 (defmacro displaying-byte-compile-warnings (&rest body)
   (declare (debug t))
@@ -1603,10 +1598,11 @@ that already has a `.elc' file."
                         (not (auto-save-file-name-p source))
                         (not (string-equal dir-locals-file
                                            (file-name-nondirectory source))))
-                   (progn (case (byte-recompile-file source force arg)
-                            (no-byte-compile (setq skip-count (1+ skip-count)))
-                            ((t) (setq file-count (1+ file-count)))
-                            ((nil) (setq fail-count (1+ fail-count))))
+                   (progn (cl-incf
+                           (pcase (byte-recompile-file source force arg)
+                             (`no-byte-compile skip-count)
+                             (`t file-count)
+                             (_ fail-count)))
                           (or noninteractive
                               (message "Checking %s..." directory))
                           (if (not (eq last-dir directory))
@@ -1632,21 +1628,20 @@ This is normally set in local file variables at the end of the elisp file:
   "Recompile FILENAME file if it needs recompilation.
 This happens when its `.elc' file is older than itself.
 
-If the `.elc' file exists and is up-to-date, normally this
-function *does not* compile FILENAME. However, if the
-prefix argument FORCE is set, that means do compile
-FILENAME even if the destination already exists and is
-up-to-date.
+If the `.elc' file exists and is up-to-date, normally this function
+*does not* compile FILENAME.  If the prefix argument FORCE is non-nil,
+however, it compiles FILENAME even if the destination already
+exists and is up-to-date.
 
-If the `.elc' file does not exist, normally this function *does
-not* compile FILENAME. If ARG is 0, that means
-compile the file even if it has never been compiled before.
-A nonzero ARG means ask the user.
+If the `.elc' file does not exist, normally this function *does not*
+compile FILENAME.  If optional argument ARG is 0, it compiles
+the input file even if the `.elc' file does not exist.
+Any other non-nil value of ARG means to ask the user.
 
-If LOAD is set, `load' the file after compiling.
+If optional argument LOAD is non-nil, loads the file after compiling.
 
-The value returned is the value returned by `byte-compile-file',
-or 'no-byte-compile if the file did not need recompilation."
+If compilation is needed, this functions returns the result of
+`byte-compile-file'; otherwise it returns 'no-byte-compile."
   (interactive
    (let ((file buffer-file-name)
 	 (file-name nil)
@@ -1676,7 +1671,8 @@ or 'no-byte-compile if the file did not need recompilation."
           (if (and noninteractive (not byte-compile-verbose))
               (message "Compiling %s..." filename))
           (byte-compile-file filename load))
-      (when load (load filename))
+      (when load
+	(load (if (file-exists-p dest) dest filename)))
       'no-byte-compile)))
 
 ;;;###autoload
@@ -1737,15 +1733,24 @@ The value is non-nil if there were no errors, nil if errors."
 	(set-buffer-multibyte nil))
       ;; Run hooks including the uncompression hook.
       ;; If they change the file name, then change it for the output also.
-      (letf ((buffer-file-name filename)
-             ((default-value 'major-mode) 'emacs-lisp-mode)
-             ;; Ignore unsafe local variables.
-             ;; We only care about a few of them for our purposes.
-             (enable-local-variables :safe)
-             (enable-local-eval nil))
-	;; Arg of t means don't alter enable-local-variables.
-        (normal-mode t)
-        (setq filename buffer-file-name))
+      (let ((buffer-file-name filename)
+            (dmm (default-value 'major-mode))
+            ;; Ignore unsafe local variables.
+            ;; We only care about a few of them for our purposes.
+            (enable-local-variables :safe)
+            (enable-local-eval nil))
+        (unwind-protect
+            (progn
+              (setq-default major-mode 'emacs-lisp-mode)
+              ;; Arg of t means don't alter enable-local-variables.
+              (normal-mode t))
+          (setq-default major-mode dmm))
+        ;; There may be a file local variable setting (bug#10419).
+        (setq buffer-read-only nil
+              filename buffer-file-name))
+      ;; Don't inherit lexical-binding from caller (bug#12938).
+      (unless (local-variable-p 'lexical-binding)
+        (setq-local lexical-binding nil))
       ;; Set the default directory, in case an eval-when-compile uses it.
       (setq default-directory (file-name-directory filename)))
     ;; Check if the file's local variables explicitly specify not to
@@ -1753,11 +1758,11 @@ The value is non-nil if there were no errors, nil if errors."
     (if (with-current-buffer input-buffer no-byte-compile)
 	(progn
 	  ;; (message "%s not compiled because of `no-byte-compile: %s'"
-	  ;; 	   (file-relative-name filename)
+	  ;; 	   (byte-compile-abbreviate-file filename)
 	  ;; 	   (with-current-buffer input-buffer no-byte-compile))
 	  (when (file-exists-p target-file)
 	    (message "%s deleted because of `no-byte-compile: %s'"
-		     (file-relative-name target-file)
+		     (byte-compile-abbreviate-file target-file)
 		     (buffer-local-value 'no-byte-compile input-buffer))
 	    (condition-case nil (delete-file target-file) (error nil)))
 	  ;; We successfully didn't compile this file.
@@ -1779,37 +1784,37 @@ The value is non-nil if there were no errors, nil if errors."
 	(with-current-buffer output-buffer
 	  (goto-char (point-max))
 	  (insert "\n")			; aaah, unix.
-	    (if (file-writable-p target-file)
-		;; We must disable any code conversion here.
-		(let* ((coding-system-for-write 'no-conversion)
-		       ;; Write to a tempfile so that if another Emacs
-		       ;; process is trying to load target-file (eg in a
-		       ;; parallel bootstrap), it does not risk getting a
-		       ;; half-finished file.  (Bug#4196)
-		       (tempfile (make-temp-name target-file))
-		       (kill-emacs-hook
-			(cons (lambda () (ignore-errors (delete-file tempfile)))
-			      kill-emacs-hook)))
-		  (if (memq system-type '(ms-dos 'windows-nt))
-		      (setq buffer-file-type t))
-		  (write-region (point-min) (point-max) tempfile nil 1)
-		  ;; This has the intentional side effect that any
-		  ;; hard-links to target-file continue to
-		  ;; point to the old file (this makes it possible
-		  ;; for installed files to share disk space with
-		  ;; the build tree, without causing problems when
-		  ;; emacs-lisp files in the build tree are
-		  ;; recompiled).  Previously this was accomplished by
-		  ;; deleting target-file before writing it.
-		  (rename-file tempfile target-file t)
-		  (message "Wrote %s" 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)))
+	  (if (file-writable-p target-file)
+	      ;; We must disable any code conversion here.
+	      (let* ((coding-system-for-write 'no-conversion)
+		     ;; Write to a tempfile so that if another Emacs
+		     ;; process is trying to load target-file (eg in a
+		     ;; parallel bootstrap), it does not risk getting a
+		     ;; half-finished file.  (Bug#4196)
+		     (tempfile (make-temp-name target-file))
+		     (kill-emacs-hook
+		      (cons (lambda () (ignore-errors (delete-file tempfile)))
+			    kill-emacs-hook)))
+		(if (memq system-type '(ms-dos 'windows-nt))
+		    (setq buffer-file-type t))
+		(write-region (point-min) (point-max) tempfile nil 1)
+		;; This has the intentional side effect that any
+		;; hard-links to target-file continue to
+		;; point to the old file (this makes it possible
+		;; for installed files to share disk space with
+		;; the build tree, without causing problems when
+		;; emacs-lisp files in the build tree are
+		;; recompiled).  Previously this was accomplished by
+		;; deleting target-file before writing it.
+		(rename-file tempfile target-file t)
+		(message "Wrote %s" 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)
@@ -1848,13 +1853,8 @@ With argument ARG, insert value in current buffer after the form."
 	     (insert "\n"))
 	    ((message "%s" (prin1-to-string value)))))))
 
-;; Dynamically bound in byte-compile-from-buffer.
-;; NB also used in cl.el and cl-macs.el.
-(defvar byte-compile--outbuffer)
-
 (defun byte-compile-from-buffer (inbuffer)
-  (let (byte-compile--outbuffer
-	(byte-compile-current-buffer inbuffer)
+  (let ((byte-compile-current-buffer inbuffer)
 	(byte-compile-read-position nil)
 	(byte-compile-last-position nil)
 	;; Prevent truncation of flonums and lists as we read and print them
@@ -1926,10 +1926,10 @@ and will be removed soon.  See (elisp)Backquote in the manual."))
       ;; if the buffer contains multibyte characters.
       (and byte-compile-current-file
 	   (with-current-buffer byte-compile--outbuffer
-	     (byte-compile-fix-header byte-compile-current-file)))))
-    byte-compile--outbuffer))
+	     (byte-compile-fix-header byte-compile-current-file))))
+     byte-compile--outbuffer)))
 
-(defun byte-compile-fix-header (filename)
+(defun byte-compile-fix-header (_filename)
   "If the current buffer has any multibyte characters, insert a version test."
   (when (< (point-max) (position-bytes (point-max)))
     (goto-char (point-min))
@@ -1954,12 +1954,10 @@ and will be removed soon.  See (elisp)Backquote in the manual."))
        ;; don't try to check the version number.
        "     (< (aref emacs-version (1- (length emacs-version))) ?A)\n"
        (format "     (string-lessp emacs-version \"%s\")\n" minimum-version)
-       "     (error \"`"
-       ;; prin1-to-string is used to quote backslashes.
-       (substring (prin1-to-string (file-name-nondirectory filename))
-		  1 -1)
-       (format "' was compiled for Emacs %s or later\"))\n\n"
-	       minimum-version))
+       ;; Because the header must fit in a fixed width, we cannot
+       ;; insert arbitrary-length file names (Bug#11585).
+       "     (error \"`%s' was compiled for "
+       (format "Emacs %s or later\" #$))\n\n" minimum-version))
       ;; Now compensate for any change in size, to make sure all
       ;; positions in the file remain valid.
       (setq delta (- (point-max) old-header-end))
@@ -2016,31 +2014,30 @@ Call from the source buffer."
        ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\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, defvaralias, defconst, autoload and
+  ;; Write the given form to the output buffer, being careful of docstrings
+  ;; in defvar, defvaralias, defconst, autoload and
   ;; custom-declare-variable 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 defvaralias defconst
-                                    autoload custom-declare-variable))
-	   (stringp (nth 3 form)))
-      (byte-compile-output-docform nil nil '("\n(" 3 ")") form nil
-				   (memq (car form)
-					 '(defvaralias autoload
-					   custom-declare-variable)))
-    (let ((print-escape-newlines t)
-	  (print-length nil)
-	  (print-level nil)
-	  (print-quoted t)
-	  (print-gensym t)
-	  (print-circle		     ; handle circular data structures
-	   (not byte-compile-disable-print-circle)))
+  (let ((print-escape-newlines t)
+        (print-length nil)
+        (print-level nil)
+        (print-quoted t)
+        (print-gensym t)
+        (print-circle                   ; Handle circular data structures.
+         (not byte-compile-disable-print-circle)))
+    (if (and (memq (car-safe form) '(defvar defvaralias defconst
+                                      autoload custom-declare-variable))
+             (stringp (nth 3 form)))
+        (byte-compile-output-docform nil nil '("\n(" 3 ")") form nil
+                                     (memq (car form)
+                                           '(defvaralias autoload
+                                              custom-declare-variable)))
       (princ "\n" byte-compile--outbuffer)
       (prin1 form byte-compile--outbuffer)
       nil)))
 
-(defvar print-gensym-alist)		;Used before print-circle existed.
 (defvar byte-compile--for-effect)
 
 (defun byte-compile-output-docform (preface name info form specindex quoted)
@@ -2070,7 +2067,6 @@ list that represents a doc string reference.
                (setq position
                      (byte-compile-output-as-comment
                       (nth (nth 1 info) form) nil))
-               (setq position (- (position-bytes position) (point-min) -1))
                ;; If the doc string starts with * (a user variable),
                ;; negate POSITION.
                (if (and (stringp (nth (nth 1 info) form))
@@ -2083,19 +2079,18 @@ list that represents a doc string reference.
               (insert preface)
               (prin1 name byte-compile--outbuffer)))
         (insert (car info))
-        (let ((print-escape-newlines t)
-              (print-quoted t)
-              ;; For compatibility with code before print-circle,
-              ;; use a cons cell to say that we want
-              ;; print-gensym-alist not to be cleared
-              ;; between calls to print functions.
-              (print-gensym '(t))
-              (print-circle             ; handle circular data structures
-               (not byte-compile-disable-print-circle))
-              print-gensym-alist     ; was used before print-circle existed.
-              (print-continuous-numbering t)
+        (let ((print-continuous-numbering t)
               print-number-table
-              (index 0))
+              (index 0)
+              ;; FIXME: The bindings below are only needed for when we're
+              ;; called from ...-defmumble.
+              (print-escape-newlines t)
+              (print-length nil)
+              (print-level nil)
+              (print-quoted t)
+              (print-gensym t)
+              (print-circle             ; Handle circular data structures.
+               (not byte-compile-disable-print-circle)))
           (prin1 (car form) byte-compile--outbuffer)
           (while (setq form (cdr form))
             (setq index (1+ index))
@@ -2116,8 +2111,6 @@ list that represents a doc string reference.
                           (byte-compile-output-as-comment
                            (cons (car form) (nth 1 form))
                            t)))
-                     (setq position (- (position-bytes position)
-                                       (point-min) -1))
                      (princ (format "(#$ . %d) nil" position)
                             byte-compile--outbuffer)
                      (setq form (cdr form))
@@ -2203,7 +2196,7 @@ list that represents a doc string reference.
 (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))))
+	 (while (if (setq form (cdr form)) (macroexp-const-p (car form))))
 	 (null form))			;Constants only
        (eval (nth 5 form))		;Macro
        (eval form))			;Define the autoload.
@@ -2211,7 +2204,10 @@ list that represents a doc string reference.
   (when (and (consp (nth 1 form))
 	   (eq (car (nth 1 form)) 'quote)
 	   (consp (cdr (nth 1 form)))
-	   (symbolp (nth 1 (nth 1 form))))
+             (symbolp (nth 1 (nth 1 form)))
+             ;; Don't add it if it's already defined.  Otherwise, it might
+             ;; hide the actual definition.
+             (not (fboundp (nth 1 (nth 1 form)))))
     (push (cons (nth 1 (nth 1 form))
 		(cons 'autoload (cdr (cdr form))))
 	  byte-compile-function-environment)
@@ -2235,22 +2231,21 @@ list that represents a doc string reference.
 (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)
-    (when (and (symbolp (nth 1 form))
-               (not (string-match "[-*/:$]" (symbol-name (nth 1 form))))
-               (byte-compile-warning-enabled-p 'lexical))
-      (byte-compile-warn "global/dynamic var `%s' lacks a prefix"
-                         (nth 1 form)))
-    (push (nth 1 form) byte-compile-bound-variables)
-    (if (eq (car form) 'defconst)
-	(push (nth 1 form) byte-compile-const-variables))
+  (when (and (symbolp (nth 1 form))
+             (not (string-match "[-*/:$]" (symbol-name (nth 1 form))))
+             (byte-compile-warning-enabled-p 'lexical))
+    (byte-compile-warn "global/dynamic var `%s' lacks a prefix"
+                       (nth 1 form)))
+  (push (nth 1 form) byte-compile-bound-variables)
+  (if (eq (car form) 'defconst)
+      (push (nth 1 form) byte-compile-const-variables))
+  (if (and (null (cddr form))		;No `value' provided.
+           (eq (car form) 'defvar))     ;Just a declaration.
+      nil
     (cond ((consp (nth 2 form))
-	   (setq form (copy-sequence form))
-	   (setcar (cdr (cdr form))
-		   (byte-compile-top-level (nth 2 form) nil 'file))))
+           (setq form (copy-sequence form))
+           (setcar (cdr (cdr form))
+                   (byte-compile-top-level (nth 2 form) nil 'file))))
     form))
 
 (put 'define-abbrev-table 'byte-hunk-handler
@@ -2266,19 +2261,7 @@ list that represents a doc string reference.
   (when (byte-compile-warning-enabled-p 'callargs)
     (byte-compile-nogroup-warn form))
   (push (nth 1 (nth 1 form)) byte-compile-bound-variables)
-  ;; Don't compile the expression because it may be displayed to the user.
-  ;; (when (eq (car-safe (nth 2 form)) 'quote)
-  ;;   ;; (nth 2 form) is meant to evaluate to an expression, so if we have the
-  ;;   ;; final value already, we can byte-compile it.
-  ;;   (setcar (cdr (nth 2 form))
-  ;;           (byte-compile-top-level (cadr (nth 2 form)) nil 'file)))
-  (let ((tail (nthcdr 4 form)))
-    (while tail
-      (unless (keywordp (car tail))      ;No point optimizing keywords.
-        ;; Compile the keyword arguments.
-        (setcar tail (byte-compile-top-level (car tail) nil 'file)))
-      (setq tail (cdr tail))))
-  form)
+  (byte-compile-keep-pending form))
 
 (put 'require 'byte-hunk-handler 'byte-compile-file-form-require)
 (defun byte-compile-file-form-require (form)
@@ -2325,143 +2308,132 @@ list that represents a doc string reference.
       (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-defmacro-declaration (form)
-  "Generate code for declarations in macro definitions.
-Remove declarations from the body of the macro definition
-by side-effects."
-  (let ((tail (nthcdr 2 form))
-        (res '()))
-    (when (stringp (car (cdr tail)))
-      (setq tail (cdr tail)))
-    (while (and (consp (car (cdr tail)))
-                (eq (car (car (cdr tail))) 'declare))
-      (let ((declaration (car (cdr tail))))
-        (setcdr tail (cdr (cdr tail)))
-        (push `(if macro-declaration-function
-                   (funcall macro-declaration-function
-                            ',(car (cdr form)) ',declaration))
-              res)))
-    res))
-
-(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))
+(defun byte-compile-file-form-defmumble (name macro arglist body rest)
+  "Process a `defalias' for NAME.
+If MACRO is non-nil, the definition is known to be a macro.
+ARGLIST is the list of arguments, if it was recognized or t otherwise.
+BODY of the definition, or t if not recognized.
+Return non-nil if everything went as planned, or nil to imply that it decided
+not to take responsibility for the actual compilation of the code."
+  (let* ((this-kind (if macro 'byte-compile-macro-environment
+                      'byte-compile-function-environment))
+         (that-kind (if macro '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-current-form name)) ; For warnings.
+
     (byte-compile-set-symbol-position name)
     ;; 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))))
+        (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 (byte-compile-warning-enabled-p 'redefine)
-	(byte-compile-arglist-warn form macrop))
+        (byte-compile-arglist-warn name arglist macro))
+
     (if byte-compile-verbose
-	(message "Compiling %s... (%s)"
-                 (or byte-compile-current-file "") (nth 1 form)))
-    (cond (that-one
-	   (if (and (byte-compile-warning-enabled-p 'redefine)
-		    ;; don't warn when compiling the stubs in byte-run...
-		    (not (assq (nth 1 form)
-			       byte-compile-initial-macro-environment)))
-	       (byte-compile-warn
+        (message "Compiling %s... (%s)"
+                 (or byte-compile-current-file "") name))
+    (cond ((not (or macro (listp body)))
+           ;; We do not know positively if the definition is a macro
+           ;; or a function, so we shouldn't emit warnings.
+           ;; This also silences "multiple definition" warnings for defmethods.
+           nil)
+          (that-one
+           (if (and (byte-compile-warning-enabled-p 'redefine)
+                    ;; Don't warn when compiling the stubs in byte-run...
+                    (not (assq name 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
-	   (when (and (byte-compile-warning-enabled-p 'redefine)
-                      ;; hack: don't warn when compiling the magic internal
+                name))
+           (setcdr that-one nil))
+          (this-one
+           (when (and (byte-compile-warning-enabled-p 'redefine)
+                      ;; 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)))
-	   (when (byte-compile-warning-enabled-p 'redefine)
-	     (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)))
-      (when (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-set-symbol-position (nth 1 form))
-	(byte-compile-warn "probable `\"' without `\\' in doc string of %s"
-			   (nth 1 form))))
-
-    ;; Generate code for declarations in macro definitions.
-    ;; Remove declarations from the body of the macro definition.
-    (when macrop
-      (dolist (decl (byte-compile-defmacro-declaration form))
-        (prin1 decl byte-compile--outbuffer)))
-
-    (let* ((code (byte-compile-lambda (nthcdr 2 form) t)))
-      (if this-one
-	  ;; A definition in b-c-initial-m-e should always take precedence
-	  ;; during compilation, so don't let it be redefined.  (Bug#8647)
-	  (or (and macrop
-		   (assq name byte-compile-initial-macro-environment))
-	      (setcdr this-one code))
-	(set this-kind
-	     (cons (cons name code)
-		   (symbol-value this-kind))))
-      (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
-           "\n(defalias '"
-           name
-           (if macrop '(" '(macro . #[" -1 "])") '(" #[" -1 "]"))
-           (append code nil)            ; Turn byte-code-function-p into list.
-           (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
-         "\n(defalias '"
-         name
-         (if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]"))
-         (append code nil)              ; Turn byte-code-function-p into list.
-         (and (atom code) byte-compile-dynamic
-              1)
-         nil))
-      (princ ")" byte-compile--outbuffer)
-      nil)))
+                      (not (assq name byte-compile-initial-macro-environment)))
+             (byte-compile-warn "%s `%s' defined multiple times in this file"
+                                (if macro "macro" "function")
+                                name)))
+          ((and (fboundp name)
+                (eq (car-safe (symbol-function name))
+                    (if macro 'lambda 'macro)))
+           (when (byte-compile-warning-enabled-p 'redefine)
+             (byte-compile-warn "%s `%s' being redefined as a %s"
+                                (if macro "function" "macro")
+                                name
+                                (if macro "macro" "function")))
+           ;; Shadow existing definition.
+           (set this-kind
+                (cons (cons name nil)
+                      (symbol-value this-kind))))
+          )
+
+    (when (and (listp body)
+               (stringp (car body))
+               (symbolp (car-safe (cdr-safe body)))
+               (car-safe (cdr-safe body))
+               (stringp (car-safe (cdr-safe (cdr-safe body)))))
+      ;; FIXME: We've done that already just above, so this looks wrong!
+      ;;(byte-compile-set-symbol-position name)
+      (byte-compile-warn "probable `\"' without `\\' in doc string of %s"
+                         name))
+
+    (if (not (listp body))
+        ;; The precise definition requires evaluation to find out, so it
+        ;; will only be known at runtime.
+        ;; For a macro, that means we can't use that macro in the same file.
+        (progn
+          (unless macro
+            (push (cons name (if (listp arglist) `(declared ,arglist) t))
+                  byte-compile-function-environment))
+          ;; Tell the caller that we didn't compile it yet.
+          nil)
+
+      (let* ((code (byte-compile-lambda (cons arglist body) t)))
+        (if this-one
+            ;; A definition in b-c-initial-m-e should always take precedence
+            ;; during compilation, so don't let it be redefined.  (Bug#8647)
+            (or (and macro
+                     (assq name byte-compile-initial-macro-environment))
+                (setcdr this-one code))
+          (set this-kind
+               (cons (cons name code)
+                     (symbol-value this-kind))))
+
+        (if rest
+            ;; There are additional args to `defalias' (like maybe a docstring)
+            ;; that the code below can't handle: punt!
+            nil
+          ;; Otherwise, we have a bona-fide defun/defmacro definition, and use
+          ;; special code to allow dynamic docstrings and byte-code.
+          (byte-compile-flush-pending)
+          (let ((index
+                 ;; If there's no doc string, provide -1 as the "doc string
+                 ;; index" so that no element will be treated as a doc string.
+                 (if (not (stringp (car body))) -1 4)))
+            ;; Output the form by hand, that's much simpler than having
+            ;; b-c-output-file-form analyze the defalias.
+            (byte-compile-output-docform
+             "\n(defalias '"
+             name
+             (if macro `(" '(macro . #[" ,index "])") `(" #[" ,index "]"))
+             (append code nil)          ; Turn byte-code-function-p into list.
+             (and (atom code) byte-compile-dynamic
+                  1)
+             nil))
+          (princ ")" byte-compile--outbuffer)
+          t)))))
 
-;; 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)))
-    (with-current-buffer byte-compile--outbuffer
+  "Print Lisp object EXP in the output file, inside a comment,
+and return the file (byte) position it will have.
+If QUOTED is non-nil, print with quoting; otherwise, print without quoting."
+  (with-current-buffer byte-compile--outbuffer
+    (let ((position (point)))
 
       ;; Insert EXP, and make it a comment with #@LENGTH.
       (insert " ")
@@ -2486,15 +2458,33 @@ by side-effects."
                                    (position-bytes 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))
-
-
+      ;; Note we add 1 to skip the space that we inserted before the actual doc
+      ;; string, and subtract point-min to convert from an 1-origin Emacs
+      ;; position to a file position.
+      (prog1
+          (- (position-bytes (point)) (point-min) -1)
+        (goto-char (point-max))))))
+
+(defun byte-compile--reify-function (fun)
+  "Return an expression which will evaluate to a function value FUN.
+FUN should be either a `lambda' value or a `closure' value."
+  (pcase-let* (((or (and `(lambda ,args . ,body) (let env nil))
+                    `(closure ,env ,args . ,body)) fun)
+               (renv ()))
+    ;; Turn the function's closed vars (if any) into local let bindings.
+    (dolist (binding env)
+      (cond
+       ((consp binding)
+        ;; We check shadowing by the args, so that the `let' can be moved
+        ;; within the lambda, which can then be unfolded.  FIXME: Some of those
+        ;; bindings might be unused in `body'.
+        (unless (memq (car binding) args) ;Shadowed.
+          (push `(,(car binding) ',(cdr binding)) renv)))
+       ((eq binding t))
+       (t (push `(defvar ,binding) body))))
+    (if (null renv)
+        `(lambda ,args ,@body)
+      `(lambda ,args (let ,(nreverse renv) ,@body)))))
 
 ;;;###autoload
 (defun byte-compile (form)
@@ -2502,23 +2492,39 @@ by side-effects."
 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)
+    (let* ((lexical-binding lexical-binding)
+           (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)
-	     ;; Expand macros.
-             (setq fun (byte-compile-preprocess fun))
-	     ;; Get rid of the `function' quote added by the `lambda' macro.
-	     (if (eq (car-safe fun) 'function) (setq fun (cadr fun)))
-	     (setq fun (if macro
-			   (cons 'macro (byte-compile-lambda fun))
-			 (byte-compile-lambda fun)))
-	     (if (symbolp form)
-		 (defalias form fun)
-	       fun)))))))
+      (cond
+       ;; Up until Emacs-24.1, byte-compile silently did nothing when asked to
+       ;; compile something invalid.  So let's tune down the complaint from an
+       ;; error to a simple message for the known case where signaling an error
+       ;; causes problems.
+       ((byte-code-function-p fun)
+        (message "Function %s is already compiled"
+                 (if (symbolp form) form "provided"))
+        fun)
+       (t
+        (when (symbolp form)
+          (unless (memq (car-safe fun) '(closure lambda))
+            (error "Don't know how to compile %S" fun))
+          (setq lexical-binding (eq (car fun) 'closure))
+          (setq fun (byte-compile--reify-function fun)))
+        (unless (eq (car-safe fun) 'lambda)
+          (error "Don't know how to compile %S" fun))
+        ;; Expand macros.
+        (setq fun (byte-compile-preprocess fun))
+        ;; Get rid of the `function' quote added by the `lambda' macro.
+        (if (eq (car-safe fun) 'function) (setq fun (cadr fun)))
+        (setq fun (byte-compile-lambda fun))
+        (if macro (push 'macro fun))
+        (if (symbolp form)
+            (fset form fun)
+          fun)))))))
 
 (defun byte-compile-sexp (sexp)
   "Compile and return SEXP."
@@ -2534,7 +2540,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 	(when (symbolp arg)
 	  (byte-compile-set-symbol-position arg))
 	(cond ((or (not (symbolp arg))
-		   (byte-compile-const-symbol-p arg t))
+		   (macroexp--const-symbol-p arg t))
 	       (error "Invalid lambda variable %s" arg))
 	      ((eq arg '&rest)
 	       (unless (cdr list)
@@ -2589,14 +2595,15 @@ If FORM is a lambda or a macro, byte-compile it as a function."
               (lsh nonrest 8)
               (lsh rest 7)))))
 
-;; Byte-compile a lambda-expression and return a valid function.
-;; The value is usually a compiled function but may be the original
-;; lambda-expression.
-;; When ADD-LAMBDA is non-nil, the symbol `lambda' is added as head
-;; of the list FUN and `byte-compile-set-symbol-position' is not called.
-;; Use this feature to avoid calling `byte-compile-set-symbol-position'
-;; for symbols generated by the byte compiler itself.
+
 (defun byte-compile-lambda (fun &optional add-lambda reserved-csts)
+  "Byte-compile a lambda-expression and return a valid function.
+The value is usually a compiled function but may be the original
+lambda-expression.
+When ADD-LAMBDA is non-nil, the symbol `lambda' is added as head
+of the list FUN and `byte-compile-set-symbol-position' is not called.
+Use this feature to avoid calling `byte-compile-set-symbol-position'
+for symbols generated by the byte compiler itself."
   (if add-lambda
       (setq fun (cons 'lambda fun))
     (unless (eq 'lambda (car-safe fun))
@@ -2657,24 +2664,23 @@ If FORM is a lambda or a macro, byte-compile it as a function."
                                         (byte-compile-make-lambda-lexenv fun))
                                    reserved-csts)))
       ;; Build the actual byte-coded function.
-      (if (eq 'byte-code (car-safe compiled))
-          (apply 'make-byte-code
-                 (if lexical-binding
-                     (byte-compile-make-args-desc arglist)
-                   arglist)
-                 (append
-                  ;; byte-string, constants-vector, stack depth
-                  (cdr compiled)
-                  ;; optionally, the doc string.
-                  (cond (lexical-binding
-                         (require 'help-fns)
-                         (list (help-add-fundoc-usage doc arglist)))
-                        ((or doc int)
-                         (list doc)))
-                  ;; optionally, the interactive spec.
-                  (if int
-                      (list (nth 1 int)))))
-        (error "byte-compile-top-level did not return byte-code")))))
+      (cl-assert (eq 'byte-code (car-safe compiled)))
+      (apply #'make-byte-code
+             (if lexical-binding
+                 (byte-compile-make-args-desc arglist)
+               arglist)
+             (append
+              ;; byte-string, constants-vector, stack depth
+              (cdr compiled)
+              ;; optionally, the doc string.
+              (cond (lexical-binding
+                     (require 'help-fns)
+                     (list (help-add-fundoc-usage doc arglist)))
+                    ((or doc int)
+                     (list doc)))
+              ;; optionally, the interactive spec.
+              (if int
+                  (list (nth 1 int))))))))
 
 (defvar byte-compile-reserved-constants 0)
 
@@ -2693,22 +2699,23 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 	 (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.
+		   65535		;  3-byte codes for the rest.
+                   65535))              ;  twice since we step when we swap.
 	 limit)
     (while (or rest other)
       (setq limit (car limits))
       (while (and rest (< i limit))
 	(cond
 	 ((numberp (car rest))
-	  (assert (< (car rest) byte-compile-reserved-constants)))
+	  (cl-assert (< (car rest) byte-compile-reserved-constants)))
 	 ((setq tmp (assq (car (car rest)) ret))
 	  (setcdr (car rest) (cdr tmp)))
 	 (t
 	  (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 limits (cdr limits)         ;Step
+	    rest (prog1 other           ;&Swap.
 		   (setq other rest))))
     (apply 'vector (nreverse (mapcar 'car ret)))))
 
@@ -2802,7 +2809,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
                   (if (if (eq (car (car rest)) 'byte-constant)
                           (or (consp tmp)
                               (and (symbolp tmp)
-                                   (not (byte-compile-const-symbol-p tmp)))))
+                                   (not (macroexp--const-symbol-p tmp)))))
                       (if maycall
                           (setq body (cons (list 'quote tmp) body)))
                     (setq body (cons tmp body))))
@@ -2819,7 +2826,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
                   (setq body (nreverse body))
                   (setq body (list
                               (if (and (eq tmp 'funcall)
-                                       (eq (car-safe (car body)) 'quote))
+                                       (eq (car-safe (car body)) 'quote)
+				       (symbolp (nth 1 (car body))))
                                   (cons (nth 1 (car body)) (cdr body))
                                 (cons tmp body))))
                   (or (eq output-type 'file)
@@ -2847,7 +2855,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
   (push (cons fn
               (if (and (consp args) (listp (car args)))
                   (list 'declared (car args))
-                t))                     ; arglist not specified
+                t))                     ; Arglist not specified.
         byte-compile-function-environment)
   ;; We are stating that it _will_ be defined at runtime.
   (setq byte-compile-noruntime-functions
@@ -2873,7 +2881,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
   (let ((byte-compile--for-effect for-effect))
     (cond
      ((not (consp form))
-      (cond ((or (not (symbolp form)) (byte-compile-const-symbol-p form))
+      (cond ((or (not (symbolp form)) (macroexp--const-symbol-p form))
              (when (symbolp form)
                (byte-compile-set-symbol-position form))
              (byte-compile-constant form))
@@ -2886,7 +2894,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
      ((symbolp (car form))
       (let* ((fn (car form))
              (handler (get fn 'byte-compile)))
-        (when (byte-compile-const-symbol-p fn)
+        (when (macroexp--const-symbol-p fn)
           (byte-compile-warn "`%s' called as a function" fn))
         (and (byte-compile-warning-enabled-p 'interactive-only)
              (memq fn byte-compile-interactive-only-functions)
@@ -2897,14 +2905,12 @@ That command is designed for interactive use only" fn))
             (byte-compile-log-warning
              (format "Forgot to expand macro %s" (car form)) nil :error))
         (if (and handler
-                 ;; Make sure that function exists.  This is important
-                 ;; for CL compiler macros since the symbol may be
-                 ;; `cl-byte-compile-compiler-macro' but if CL isn't
-                 ;; loaded, this function doesn't exist.
-                 (and (not (eq handler
-                               ;; Already handled by macroexpand-all.
-                               'cl-byte-compile-compiler-macro))
-                      (functionp handler)))
+                 ;; Make sure that function exists.
+                 (and (functionp handler)
+                      ;; Ignore obsolete byte-compile function used by former
+                      ;; CL code to handle compiler macros (we do it
+                      ;; differently now).
+                      (not (eq handler 'cl-byte-compile-compiler-macro))))
             (funcall handler form)
           (byte-compile-normal-call form))
         (if (byte-compile-warning-enabled-p 'cl-functions)
@@ -2981,14 +2987,14 @@ That command is designed for interactive use only" fn))
     (mapc 'byte-compile-form (cdr form))
     (unless fmax2
       ;; Old-style byte-code.
-      (assert (listp fargs))
+      (cl-assert (listp fargs))
       (while fargs
-        (case (car fargs)
-          (&optional (setq fargs (cdr fargs)))
-          (&rest (setq fmax2 (+ (* 2 (length dynbinds)) 1))
+        (pcase (car fargs)
+          (`&optional (setq fargs (cdr fargs)))
+          (`&rest (setq fmax2 (+ (* 2 (length dynbinds)) 1))
                  (push (cadr fargs) dynbinds)
                  (setq fargs nil))
-          (t (push (pop fargs) dynbinds))))
+          (_ (push (pop fargs) dynbinds))))
       (unless fmax2 (setq fmax2 (* 2 (length dynbinds)))))
     (cond
      ((<= (+ alen alen) fmax2)
@@ -3002,7 +3008,7 @@ That command is designed for interactive use only" fn))
      (t
       ;; Turn &rest args into a list.
       (let ((n (- alen (/ (1- fmax2) 2))))
-        (assert (> n 0) nil "problem: fmax2=%S alen=%S n=%S" fmax2 alen n)
+        (cl-assert (> n 0) nil "problem: fmax2=%S alen=%S n=%S" fmax2 alen n)
         (if (< n 5)
             (byte-compile-out
              (aref [byte-list1 byte-list2 byte-list3 byte-list4] (1- n))
@@ -3015,14 +3021,14 @@ That command is designed for interactive use only" fn))
     ;; Unbind dynamic variables.
     (when dynbinds
       (byte-compile-out 'byte-unbind (length dynbinds)))
-    (assert (eq byte-compile-depth (1+ start-depth))
+    (cl-assert (eq byte-compile-depth (1+ start-depth))
             nil "Wrong depth start=%s end=%s" start-depth byte-compile-depth)))
 
 (defun byte-compile-check-variable (var access-type)
   "Do various error checks before a use of the variable VAR."
   (when (symbolp var)
     (byte-compile-set-symbol-position var))
-  (cond ((or (not (symbolp var)) (byte-compile-const-symbol-p var))
+  (cond ((or (not (symbolp var)) (macroexp--const-symbol-p var))
 	 (when (byte-compile-warning-enabled-p 'constants)
 	   (byte-compile-warn (if (eq access-type 'let-bind)
 				  "attempt to let-bind %s `%s`"
@@ -3033,10 +3039,10 @@ That command is designed for interactive use only" fn))
            (and od
                 (not (memq var byte-compile-not-obsolete-vars))
                 (not (memq var byte-compile-global-not-obsolete-vars))
-                (or (case (nth 1 od)
-                      (set (not (eq access-type 'reference)))
-                      (get (eq access-type 'reference))
-                      (t t)))))
+                (or (pcase (nth 1 od)
+                      (`set (not (eq access-type 'reference)))
+                      (`get (eq access-type 'reference))
+                      (_ t)))))
 	 (byte-compile-warn-obsolete var))))
 
 (defsubst byte-compile-dynamic-variable-op (base-op var)
@@ -3073,9 +3079,9 @@ That command is designed for interactive use only" fn))
   (byte-compile-check-variable var 'assign)
   (let ((lex-binding (assq var byte-compile--lexical-environment)))
     (if lex-binding
-	;; VAR is lexically bound
+	;; VAR is lexically bound.
         (byte-compile-stack-set (cdr lex-binding))
-      ;; VAR is dynamically bound
+      ;; VAR is dynamically bound.
       (unless (or (not (byte-compile-warning-enabled-p 'free-vars))
 		  (boundp var)
 		  (memq var byte-compile-bound-variables)
@@ -3360,7 +3366,8 @@ discarding."
            (body (nthcdr 3 form))
            (fun
             (byte-compile-lambda `(lambda ,vars . ,body) nil (length env))))
-      (assert (byte-code-function-p fun))
+      (cl-assert (> (length env) 0))       ;Otherwise, we don't need a closure.
+      (cl-assert (byte-code-function-p fun))
       (byte-compile-form `(make-byte-code
                            ',(aref fun 0) ',(aref fun 1)
                            (vconcat (vector . ,env) ',(aref fun 2))
@@ -3585,20 +3592,22 @@ discarding."
 
 (defun byte-compile-setq-default (form)
   (setq form (cdr form))
-  (if (> (length form) 2)
-      (let ((setters ()))
-        (while (consp form)
-          (push `(setq-default ,(pop form) ,(pop form)) setters))
-        (byte-compile-form (cons 'progn (nreverse setters))))
-    (let ((var (car form)))
-      (and (or (not (symbolp var))
-               (byte-compile-const-symbol-p var t))
-           (byte-compile-warning-enabled-p 'constants)
-           (byte-compile-warn
-            "variable assignment to %s `%s'"
-            (if (symbolp var) "constant" "nonvariable")
-            (prin1-to-string var)))
-      (byte-compile-normal-call `(set-default ',var ,@(cdr form))))))
+  (if (null form)			; (setq-default), with no arguments
+      (byte-compile-form nil byte-compile--for-effect)
+    (if (> (length form) 2)
+	(let ((setters ()))
+	  (while (consp form)
+	    (push `(setq-default ,(pop form) ,(pop form)) setters))
+	  (byte-compile-form (cons 'progn (nreverse setters))))
+      (let ((var (car form)))
+	(and (or (not (symbolp var))
+		 (macroexp--const-symbol-p var t))
+	     (byte-compile-warning-enabled-p 'constants)
+	     (byte-compile-warn
+	      "variable assignment to %s `%s'"
+	      (if (symbolp var) "constant" "nonvariable")
+	      (prin1-to-string var)))
+	(byte-compile-normal-call `(set-default ',var ,@(cdr form)))))))
 
 (byte-defop-compiler-1 set-default)
 (defun byte-compile-set-default (form)
@@ -3699,10 +3708,10 @@ If CONDITION's value is (not (featurep 'emacs)) or (featurep 'xemacs),
 that suppresses all warnings during execution of BODY."
   (declare (indent 1) (debug t))
   `(let* ((fbound-list (byte-compile-find-bound-condition
-			,condition (list 'fboundp)
+			,condition '(fboundp functionp)
 			byte-compile-unresolved-functions))
 	  (bound-list (byte-compile-find-bound-condition
-		       ,condition (list 'boundp 'default-boundp)))
+		       ,condition '(boundp default-boundp)))
 	  ;; Maybe add to the bound list.
 	  (byte-compile-bound-variables
            (append bound-list byte-compile-bound-variables)))
@@ -3725,7 +3734,7 @@ that suppresses all warnings during execution of BODY."
 (defun byte-compile-if (form)
   (byte-compile-form (car (cdr form)))
   ;; Check whether we have `(if (fboundp ...' or `(if (boundp ...'
-  ;; and avoid warnings about the relevent symbols in the consequent.
+  ;; and avoid warnings about the relevant symbols in the consequent.
   (let ((clause (nth 1 form))
 	(donetag (byte-compile-make-tag)))
     (if (null (nthcdr 3 form))
@@ -3938,8 +3947,8 @@ binding slots have been popped."
         (if lexical-binding
             ;; Unbind both lexical and dynamic variables.
             (progn
-              (assert (or (eq byte-compile-depth init-stack-depth)
-                          (eq byte-compile-depth (1+ init-stack-depth))))
+              (cl-assert (or (eq byte-compile-depth init-stack-depth)
+                             (eq byte-compile-depth (1+ init-stack-depth))))
               (byte-compile-unbind clauses init-lexenv (> byte-compile-depth
                                                           init-stack-depth)))
           ;; Unbind dynamic variables.
@@ -4081,36 +4090,11 @@ binding slots have been popped."
 
 ;;; 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)
 
-(defun byte-compile-defun (form)
-  ;; This is not used for file-level defuns with doc strings.
-  (if (symbolp (car form))
-      (byte-compile-set-symbol-position (car form))
-    (byte-compile-set-symbol-position 'defun)
-    (error "defun name must be a symbol, not %s" (car form)))
-  (byte-compile-push-constant 'defalias)
-  (byte-compile-push-constant (nth 1 form))
-  (byte-compile-push-constant (byte-compile-lambda (cdr (cdr form)) t))
-  (byte-compile-out 'byte-call 2))
-
-(defun byte-compile-defmacro (form)
-  ;; This is not used for file-level defmacros with doc strings.
-  (byte-compile-body-do-effect
-   (let ((decls (byte-compile-defmacro-declaration form))
-         (code (byte-compile-lambda (cdr (cdr form)) t)))
-     `((defalias ',(nth 1 form)
-         ,(if (eq (car-safe code) 'make-byte-code)
-              `(cons 'macro ,code)
-            `'(macro . ,(eval code))))
-       ,@decls
-       ',(nth 1 form)))))
-
 ;; If foo.el declares `toto' as obsolete, it is likely that foo.el will
 ;; actually use `toto' in order for this obsolete variable to still work
 ;; correctly, so paradoxically, while byte-compiling foo.el, the presence
@@ -4122,8 +4106,10 @@ binding slots have been popped."
     (push (nth 1 (nth 1 form)) byte-compile-global-not-obsolete-vars))
   (byte-compile-normal-call form))
 
+(defconst byte-compile-tmp-var (make-symbol "def-tmp-var"))
+
 (defun byte-compile-defvar (form)
-  ;; This is not used for file-level defvar/consts with doc strings.
+  ;; This is not used for file-level defvar/consts.
   (when (and (symbolp (nth 1 form))
              (not (string-match "[-*/:$]" (symbol-name (nth 1 form))))
              (byte-compile-warning-enabled-p 'lexical))
@@ -4146,37 +4132,26 @@ binding slots have been popped."
     (push var byte-compile-bound-variables)
     (if (eq fun 'defconst)
 	(push var byte-compile-const-variables))
-    (byte-compile-body-do-effect
-     (list
-      ;; Put the defined variable in this library's load-history entry
-      ;; just as a real defvar would, but only in top-level forms.
-      (when (and (cddr form) (null byte-compile-current-form))
-	`(setq current-load-list (cons ',var current-load-list)))
-      (when (> (length form) 3)
-	(when (and string (not (stringp string)))
-	    (byte-compile-warn "third arg to `%s %s' is not a string: %s"
-			       fun var string))
-	`(put ',var 'variable-documentation ,string))
-      (if (cddr form)		; `value' provided
-	  (let ((byte-compile-not-obsolete-vars (list var)))
-	    (if (eq fun 'defconst)
-		;; `defconst' sets `var' unconditionally.
-		(let ((tmp (make-symbol "defconst-tmp-var")))
-                  ;; Quote with `quote' to prevent byte-compiling the body,
-                  ;; which would lead to an inf-loop.
-		  `(funcall '(lambda (,tmp) (defconst ,var ,tmp))
-			    ,value))
-	      ;; `defvar' sets `var' only when unbound.
-	      `(if (not (default-boundp ',var)) (setq-default ,var ,value))))
-	(when (eq fun 'defconst)
-	  ;; This will signal an appropriate error at runtime.
-	  `(eval ',form)))
-      `',var))))
+    (when (and string (not (stringp string)))
+      (byte-compile-warn "third arg to `%s %s' is not a string: %s"
+                         fun var string))
+    (byte-compile-form-do-effect
+     (if (cddr form)  ; `value' provided
+         ;; Quote with `quote' to prevent byte-compiling the body,
+         ;; which would lead to an inf-loop.
+         `(funcall '(lambda (,byte-compile-tmp-var)
+                      (,fun ,var ,byte-compile-tmp-var ,@(nthcdr 3 form)))
+                   ,value)
+        (if (eq fun 'defconst)
+            ;; This will signal an appropriate error at runtime.
+            `(eval ',form)
+          ;; A simple (defvar foo) just returns foo.
+          `',var)))))
 
 (defun byte-compile-autoload (form)
   (byte-compile-set-symbol-position 'autoload)
-  (and (byte-compile-constp (nth 1 form))
-       (byte-compile-constp (nth 5 form))
+  (and (macroexp-const-p (nth 1 form))
+       (macroexp-const-p (nth 5 form))
        (eval (nth 5 form))  ; macro-p
        (not (fboundp (eval (nth 1 form))))
        (byte-compile-warn
@@ -4195,38 +4170,53 @@ binding slots have been popped."
 (put 'defalias 'byte-hunk-handler 'byte-compile-file-form-defalias)
 ;; Used for eieio--defalias as well.
 (defun byte-compile-file-form-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))))
-      (let ((constant
-	     (and (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))))))
-	(byte-compile-defalias-warn (nth 1 (nth 1 form)))
-	(push (cons (nth 1 (nth 1 form))
-		    (if constant (nth 1 (nth 2 form)) t))
-	      byte-compile-function-environment)))
-  ;; We used to just do: (byte-compile-normal-call form)
-  ;; But it turns out that this fails to optimize the code.
-  ;; So instead we now do the same as what other byte-hunk-handlers do,
-  ;; which is to call back byte-compile-file-form and then return nil.
-  ;; Except that we can't just call byte-compile-file-form since it would
-  ;; call us right back.
-  (byte-compile-keep-pending form)
-  ;; Return nil so the form is not output twice.
-  nil)
-
-;; 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)
-  (let ((calls (assq new byte-compile-unresolved-functions)))
-    (if calls
-	(setq byte-compile-unresolved-functions
-	      (delq calls byte-compile-unresolved-functions)))))
+  ;; For the compilation itself, we could largely get rid of this hunk-handler,
+  ;; if it weren't for the fact that we need to figure out when a defalias
+  ;; defines a macro, so as to add it to byte-compile-macro-environment.
+  ;;
+  ;; FIXME: we also use this hunk-handler to implement the function's dynamic
+  ;; docstring feature.  We could actually implement it more elegantly in
+  ;; byte-compile-lambda so it applies to all lambdas, but the problem is that
+  ;; the resulting .elc format will not be recognized by make-docfile, so
+  ;; either we stop using DOC for the docstrings of preloaded elc files (at the
+  ;; cost of around 24KB on 32bit hosts, double on 64bit hosts) or we need to
+  ;; build DOC in a more clever way (e.g. handle anonymous elements).
+  (let ((byte-compile-free-references nil)
+        (byte-compile-free-assignments nil))
+    (pcase form
+      ;; Decompose `form' into:
+      ;; - `name' is the name of the defined function.
+      ;; - `arg' is the expression to which it is defined.
+      ;; - `rest' is the rest of the arguments.
+      (`(,_ ',name ,arg . ,rest)
+       (pcase-let*
+           ;; `macro' is non-nil if it defines a macro.
+           ;; `fun' is the function part of `arg' (defaults to `arg').
+           (((or (and (or `(cons 'macro ,fun) `'(macro . ,fun)) (let macro t))
+                 (and (let fun arg) (let macro nil)))
+             arg)
+            ;; `lam' is the lambda expression in `fun' (or nil if not
+            ;; recognized).
+            ((or `(,(or `quote `function) ,lam) (let lam nil))
+             fun)
+            ;; `arglist' is the list of arguments (or t if not recognized).
+            ;; `body' is the body of `lam' (or t if not recognized).
+            ((or `(lambda ,arglist . ,body)
+                 ;; `(closure ,_ ,arglist . ,body)
+                 (and `(internal-make-closure ,arglist . ,_) (let body t))
+                 (and (let arglist t) (let body t)))
+             lam))
+         (unless (byte-compile-file-form-defmumble
+                  name macro arglist body rest)
+           (byte-compile-keep-pending form))))
+
+      ;; We used to just do: (byte-compile-normal-call form)
+      ;; But it turns out that this fails to optimize the code.
+      ;; So instead we now do the same as what other byte-hunk-handlers do,
+      ;; which is to call back byte-compile-file-form and then return nil.
+      ;; Except that we can't just call byte-compile-file-form since it would
+      ;; call us right back.
+      (t (byte-compile-keep-pending form)))))
 
 (byte-defop-compiler-1 with-no-warnings byte-compile-no-warnings)
 (defun byte-compile-no-warnings (form)
@@ -4378,21 +4368,21 @@ invoked interactively."
     (if byte-compile-call-tree-sort
 	(setq byte-compile-call-tree
 	      (sort byte-compile-call-tree
-		    (case byte-compile-call-tree-sort
-                      (callers
+		    (pcase byte-compile-call-tree-sort
+                      (`callers
                        (lambda (x y) (< (length (nth 1 x))
                                    (length (nth 1 y)))))
-                      (calls
+                      (`calls
                        (lambda (x y) (< (length (nth 2 x))
                                    (length (nth 2 y)))))
-                      (calls+callers
+                      (`calls+callers
                        (lambda (x y) (< (+ (length (nth 1 x))
                                       (length (nth 2 x)))
                                    (+ (length (nth 1 y))
                                       (length (nth 2 y))))))
-                      (name
+                      (`name
                        (lambda (x y) (string< (car x) (car y))))
-                      (t (error "`byte-compile-call-tree-sort': `%s' - unknown sort mode"
+                      (_ (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)
@@ -4534,29 +4524,30 @@ already up-to-date."
     (kill-emacs (if error 1 0))))
 
 (defun batch-byte-compile-file (file)
-  (if debug-on-error
-      (byte-compile-file file)
-    (condition-case err
-	(byte-compile-file file)
-      (file-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)))
-       (let ((destfile (byte-compile-dest-file file)))
-	 (if (file-exists-p destfile)
-	     (delete-file destfile)))
-       nil)
-      (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))))
+  (let ((byte-compile-root-dir (or byte-compile-root-dir default-directory)))
+    (if debug-on-error
+        (byte-compile-file file)
+      (condition-case err
+          (byte-compile-file file)
+        (file-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)))
+         (let ((destfile (byte-compile-dest-file file)))
+           (if (file-exists-p destfile)
+               (delete-file destfile)))
+         nil)
+        (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)))))
 
 (defun byte-compile-refresh-preloaded ()
   "Reload any Lisp file that was changed since Emacs was dumped.
@@ -4604,6 +4595,16 @@ and corresponding effects."
     (setq command-line-args-left (cdr command-line-args-left)))
   (kill-emacs 0))
 
+;;; Core compiler macros.
+
+(put 'featurep 'compiler-macro
+     (lambda (form feature &rest _ignore)
+       ;; Emacs-21's byte-code doesn't run under XEmacs or SXEmacs anyway, so
+       ;; we can safely optimize away this test.
+       (if (member feature '('xemacs 'sxemacs 'emacs))
+           (eval form)
+         form)))
+
 (provide 'byte-compile)
 (provide 'bytecomp)
 
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index daafd2226ec..5a1d6265848 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -1,6 +1,6 @@
 ;;; cconv.el --- Closure conversion for statically scoped Emacs lisp. -*- lexical-binding: t; coding: utf-8 -*-
 
-;; Copyright (C) 2011  Free Software Foundation, Inc.
+;; Copyright (C) 2011-2012  Free Software Foundation, Inc.
 
 ;; Author: Igor Kuzmin <kzuminig@iro.umontreal.ca>
 ;; Maintainer: FSF
@@ -73,8 +73,6 @@
 ;;   since afterwards they can because obnoxious (warnings about an "unused
 ;;   variable" should not be emitted when the variable use has simply been
 ;;   optimized away).
-;; - turn defun and defmacro into macros (and remove special handling of
-;;   `declare' afterwards).
 ;; - let macros specify that some let-bindings come from the same source,
 ;;   so the unused warning takes all uses into account.
 ;; - let interactive specs return a function to build the args (to stash into
@@ -112,7 +110,7 @@
 ;;     ,@(mapcar (lambda (binder) (if (consp binder) (cadr binder)))
 ;;               binders)))
 
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
 
 (defconst cconv-liftwhen 6
   "Try to do lambda lifting if the number of arguments + free variables
@@ -175,7 +173,7 @@ Returns a form where all lambdas don't have any free variables."
   ;; Here we assume that X appears at most once in M.
   (let* ((b (assq x m))
          (res (if b (remq b m) m)))
-    (assert (null (assq x res))) ;; Check the assumption was warranted.
+    (cl-assert (null (assq x res))) ;; Check the assumption was warranted.
     res))
 
 (defun cconv--map-diff-set (m s)
@@ -187,7 +185,7 @@ Returns a form where all lambdas don't have any free variables."
     (nreverse res)))
 
 (defun cconv--convert-function (args body env parentform)
-  (assert (equal body (caar cconv-freevars-alist)))
+  (cl-assert (equal body (caar cconv-freevars-alist)))
   (let* ((fvs (cdr (pop cconv-freevars-alist)))
          (body-new '())
          (letbind '())
@@ -253,11 +251,11 @@ ENV is a list where each entry takes the shape either:
 EXTEND is a list of variables which might need to be accessed even from places
 where they are shadowed, because some part of ENV causes them to be used at
 places where they originally did not directly appear."
-  (assert (not (delq nil (mapcar (lambda (mapping)
-                                   (if (eq (cadr mapping) 'apply-partially)
-                                       (cconv--set-diff (cdr (cddr mapping))
-                                                        extend)))
-                                 env))))
+  (cl-assert (not (delq nil (mapcar (lambda (mapping)
+                                      (if (eq (cadr mapping) 'apply-partially)
+                                          (cconv--set-diff (cdr (cddr mapping))
+                                                           extend)))
+                                    env))))
 
   ;; What's the difference between fvrs and envs?
   ;; Suppose that we have the code
@@ -289,10 +287,10 @@ places where they originally did not directly appear."
                   ;; Check if var is a candidate for lambda lifting.
                   ((and (member (cons binder form) cconv-lambda-candidates)
                         (progn
-                          (assert (and (eq (car value) 'function)
-                                       (eq (car (cadr value)) 'lambda)))
-                          (assert (equal (cddr (cadr value))
-                                         (caar cconv-freevars-alist)))
+                          (cl-assert (and (eq (car value) 'function)
+                                          (eq (car (cadr value)) 'lambda)))
+                          (cl-assert (equal (cddr (cadr value))
+                                            (caar cconv-freevars-alist)))
                           ;; Peek at the freevars to decide whether to λ-lift.
                           (let* ((fvs (cdr (car cconv-freevars-alist)))
                                  (fun (cadr value))
@@ -309,7 +307,7 @@ places where they originally did not directly appear."
                           (funcbody-env ()))
                      (push `(,var . (apply-partially ,var . ,fvs)) new-env)
                      (dolist (fv fvs)
-                       (pushnew fv new-extend)
+                       (cl-pushnew fv new-extend)
                        (if (and (eq 'car (car-safe (cdr (assq fv env))))
                                 (not (memq fv funargs)))
                            (push `(,fv . (car ,fv)) funcbody-env)))
@@ -347,14 +345,14 @@ places where they originally did not directly appear."
                      (mapcar (lambda (mapping)
                                (if (not (eq (cadr mapping) 'apply-partially))
                                    mapping
-                                 (assert (eq (car mapping) (nth 2 mapping)))
-                                 (list* (car mapping)
-                                        'apply-partially
-                                        (car mapping)
-                                        (mapcar (lambda (arg)
-                                                  (if (eq var arg)
-                                                      closedsym arg))
-                                                (nthcdr 3 mapping)))))
+                                 (cl-assert (eq (car mapping) (nth 2 mapping)))
+                                 `(,(car mapping)
+                                   apply-partially
+                                   ,(car mapping)
+                                   ,@(mapcar (lambda (arg)
+                                               (if (eq var arg)
+                                                   closedsym arg))
+                                             (nthcdr 3 mapping)))))
                              new-env))
                (setq new-extend (remq var new-extend))
                (push closedsym new-extend)
@@ -410,20 +408,6 @@ places where they originally did not directly appear."
             . ,(mapcar (lambda (form) (cconv-convert form env extend))
                        forms)))
 
-					;defun, defmacro
-    (`(,(and sym (or `defun `defmacro))
-       ,func ,args . ,body)
-     (assert (equal body (caar cconv-freevars-alist)))
-     (assert (null (cdar cconv-freevars-alist)))
-
-     (let ((new (cconv--convert-function args body env form)))
-       (pcase new
-         (`(function (lambda ,newargs . ,new-body))
-          (assert (equal args newargs))
-          `(,sym ,func ,args . ,new-body))
-         (t (byte-compile-report-error
-             (format "Internal error in cconv of (%s %s ...)" sym func))))))
-
 					;condition-case
     (`(condition-case ,var ,protected-form . ,handlers)
      (let ((newform (cconv--convert-function
@@ -471,7 +455,7 @@ places where they originally did not directly appear."
      (let ((mapping (cdr (assq fun env))))
        (pcase mapping
          (`(apply-partially ,_ . ,(and fvs `(,_ . ,_)))
-          (assert (eq (cadr mapping) fun))
+          (cl-assert (eq (cadr mapping) fun))
           `(,callsym ,fun
                      ,@(mapcar (lambda (fv)
                                  (let ((exp (or (cdr (assq fv env)) fv)))
@@ -567,7 +551,7 @@ FORM is the parent form that binds this var."
     ;; Transfer uses collected in `envcopy' (via `newenv') back to `env';
     ;; and compute free variables.
     (while env
-      (assert (and envcopy (eq (caar env) (caar envcopy))))
+      (cl-assert (and envcopy (eq (caar env) (caar envcopy))))
       (let ((free nil)
             (x (cdr (car env)))
             (y (cdr (car envcopy))))
@@ -618,15 +602,6 @@ and updates the data stored in ENV."
        (dolist (vardata newvars)
          (cconv--analyse-use vardata form "variable"))))
 
-					; defun special form
-    (`(,(or `defun `defmacro) ,func ,vrs . ,body-forms)
-     (when env
-       (byte-compile-log-warning
-        (format "Function %S will ignore its context %S"
-                func (mapcar #'car env))
-        t :warning))
-     (cconv--analyse-function vrs body-forms nil form))
-
     (`(function (lambda ,vrs . ,body-forms))
      (cconv--analyse-function vrs body-forms env form))
 
@@ -639,7 +614,9 @@ and updates the data stored in ENV."
        (cconv-analyse-form (cadr forms) env)
        (setq forms (cddr forms))))
 
-    (`((lambda . ,_) . ,_)             ; first element is lambda expression
+    (`((lambda . ,_) . ,_)             ; First element is lambda expression.
+     (byte-compile-log-warning
+      "Use of deprecated ((lambda ...) ...) form" t :warning)
      (dolist (exp `((function ,(car form)) . ,(cdr form)))
        (cconv-analyse-form exp env)))
 
diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el
index e9f2ec54601..31aeb1f8076 100644
--- a/lisp/emacs-lisp/chart.el
+++ b/lisp/emacs-lisp/chart.el
@@ -1,6 +1,6 @@
-;;; chart.el --- Draw charts (bar charts, etc)
+;;; chart.el --- Draw charts (bar charts, etc)  -*- lexical-binding: t -*-
 
-;; Copyright (C) 1996, 1998-1999, 2001, 2004-2005, 2007-2011
+;; Copyright (C) 1996, 1998-1999, 2001, 2004-2005, 2007-2012
 ;;   Free Software Foundation, Inc.
 
 ;; Author: Eric M. Ludlam  <zappo@gnu.org>
@@ -62,8 +62,8 @@
 (require 'eieio)
 
 ;;; Code:
-(defvar chart-mode-map (make-sparse-keymap) "Keymap used in chart mode.")
 (define-obsolete-variable-alias 'chart-map 'chart-mode-map "24.1")
+(defvar chart-mode-map (make-sparse-keymap) "Keymap used in chart mode.")
 
 (defvar chart-local-object nil
   "Local variable containing the locally displayed chart object.")
@@ -82,7 +82,7 @@ Colors will be the background color.")
 Useful if new Emacs is used on B&W display.")
 
 (defcustom chart-face-use-pixmaps nil
-  "*Non-nil to use fancy pixmaps in the background of chart face colors."
+  "Non-nil to use fancy pixmaps in the background of chart face colors."
   :group 'eieio
   :type 'boolean)
 
@@ -156,7 +156,7 @@ Returns the newly created buffer."
    )
   "Superclass for all charts to be displayed in an Emacs buffer.")
 
-(defmethod initialize-instance :AFTER ((obj chart) &rest fields)
+(defmethod initialize-instance :AFTER ((obj chart) &rest _fields)
   "Initialize the chart OBJ being created with FIELDS.
 Make sure the width/height is correct."
   (oset obj x-width (- (window-width) 10))
@@ -276,7 +276,7 @@ START and END represent the boundary."
 		       (float (- (cdr range) (car range)))))))))
   )
 
-(defmethod chart-axis-draw ((a chart-axis-range) &optional dir margin zone start end)
+(defmethod chart-axis-draw ((a chart-axis-range) &optional dir margin zone _start _end)
   "Draw axis information based upon a range to be spread along the edge.
 A is the chart to draw.  DIR is the direction.
 MARGIN, ZONE, START, and END specify restrictions in chart space."
@@ -329,7 +329,7 @@ Automatically compensates for direction."
 	  (+ m -1 (round (* lpn (+ 1.0 (float n))))))
     ))
 
-(defmethod chart-axis-draw ((a chart-axis-names) &optional dir margin zone start end)
+(defmethod chart-axis-draw ((a chart-axis-names) &optional dir margin zone _start _end)
   "Draw axis information based upon A range to be spread along the edge.
 Optional argument DIR is the direction of the chart.
 Optional arguments MARGIN, ZONE, START and END specify boundaries of the drawing."
@@ -675,28 +675,14 @@ SORT-PRED if desired."
 (defun chart-emacs-storage ()
   "Chart the current storage requirements of Emacs."
   (interactive)
-  (let* ((data (garbage-collect))
-	 (names '("strings/2" "vectors"
-		  "conses" "free cons"
-		  "syms" "free syms"
-		  "markers" "free mark"
-		  ;; "floats" "free flt"
-		  ))
-	 (nums (list (/ (nth 3 data) 2)
-		     (nth 4 data)
-		     (car (car data))	; conses
-		     (cdr (car data))
-		     (car (nth 1 data)) ; syms
-		     (cdr (nth 1 data))
-		     (car (nth 2 data))	; markers
-		     (cdr (nth 2 data))
-		     ;(car (nth 5 data)) ; floats are Emacs only
-		     ;(cdr (nth 5 data))
-		     )))
+  (let* ((data (garbage-collect)))
     ;; Let's create the chart!
     (chart-bar-quickie 'vertical "Emacs Runtime Storage Usage"
-		       names "Storage Items"
-		       nums "Objects")))
+		       (mapcar (lambda (x) (symbol-name (car x))) data)
+                       "Storage Items"
+		       (mapcar (lambda (x) (* (nth 1 x) (nth 2 x)))
+                               data)
+                       "Bytes")))
 
 (defun chart-emacs-lists ()
   "Chart out the size of various important lists."
diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el
index e15920ef009..d4213899ef6 100644
--- a/lisp/emacs-lisp/check-declare.el
+++ b/lisp/emacs-lisp/check-declare.el
@@ -1,6 +1,6 @@
 ;;; check-declare.el --- Check declare-function statements
 
-;; Copyright (C) 2007-2011  Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
 
 ;; Author: Glenn Morris <rgm@gnu.org>
 ;; Keywords: lisp, tools, maint
@@ -28,7 +28,7 @@
 ;; checks that all such statements in a file or directory are accurate.
 ;; The entry points are `check-declare-file' and `check-declare-directory'.
 
-;; For more information, see Info node `elisp(Declaring Functions)'.
+;; For more information, see Info node `(elisp)Declaring Functions'.
 
 ;;; TODO:
 
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index 9b708d4bbd2..1cbed17cbab 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -1,6 +1,6 @@
 ;;; checkdoc.el --- check documentation strings for style requirements
 
-;; Copyright (C) 1997-1998, 2001-2011  Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2001-2012  Free Software Foundation, Inc.
 
 ;; Author: Eric M. Ludlam <zappo@gnu.org>
 ;; Version: 0.6.2
@@ -124,7 +124,7 @@
 ;; Adding your own checks:
 ;;
 ;;   You can experiment with adding your own checks by setting the
-;; hooks `checkdoc-style-hooks' and `checkdoc-comment-style-hooks'.
+;; hooks `checkdoc-style-functions' and `checkdoc-comment-style-functions'.
 ;; Return a string which is the error you wish to report.  The cursor
 ;; position should be preserved.
 ;;
@@ -274,17 +274,21 @@ made in the style guide relating to order."
   :type 'boolean)
 ;;;###autoload(put 'checkdoc-arguments-in-order-flag 'safe-local-variable 'booleanp)
 
-(defvar checkdoc-style-hooks nil
-  "Hooks called after the standard style check is completed.
-All hooks must return nil or a string representing the error found.
+(define-obsolete-variable-alias 'checkdoc-style-hooks
+  'checkdoc-style-functions "24.3")
+(defvar checkdoc-style-functions nil
+  "Hook run after the standard style check is completed.
+All functions must return nil or a string representing the error found.
 Useful for adding new user implemented commands.
 
 Each hook is called with two parameters, (DEFUNINFO ENDPOINT).
 DEFUNINFO is the return value of `checkdoc-defun-info'.  ENDPOINT is the
 location of end of the documentation string.")
 
-(defvar checkdoc-comment-style-hooks nil
-  "Hooks called after the standard comment style check is completed.
+(define-obsolete-variable-alias 'checkdoc-comment-style-hooks
+  'checkdoc-comment-style-functions "24.3")
+(defvar checkdoc-comment-style-functions nil
+  "Hook run after the standard comment style check is completed.
 Must return nil if no errors are found, or a string describing the
 problem discovered.  This is useful for adding additional checks.")
 
@@ -916,7 +920,7 @@ is the starting location.  If this is nil, `point-min' is used instead."
 	(progn
 	  (goto-char wrong)
 	  (if (not take-notes)
-	      (error "%s" (checkdoc-error-text msg)))))
+	      (user-error "%s" (checkdoc-error-text msg)))))
     (checkdoc-show-diagnostics)
     (if (called-interactively-p 'interactive)
 	(message "No style warnings."))))
@@ -949,7 +953,7 @@ if there is one."
 	 (e (checkdoc-file-comments-engine))
          (checkdoc-generate-compile-warnings-flag
           (or take-notes checkdoc-generate-compile-warnings-flag)))
-    (if e (error "%s" (checkdoc-error-text e)))
+    (if e (user-error "%s" (checkdoc-error-text e)))
     (checkdoc-show-diagnostics)
     e))
 
@@ -987,7 +991,7 @@ Optional argument TAKE-NOTES causes all errors to be logged."
     (if (not (called-interactively-p 'interactive))
 	e
       (if e
-	  (error "%s" (checkdoc-error-text e))
+	  (user-error "%s" (checkdoc-error-text e))
 	(checkdoc-show-diagnostics)))
     (goto-char p))
   (if (called-interactively-p 'interactive)
@@ -1027,19 +1031,14 @@ space at the end of each line."
 	      (car (memq checkdoc-spellcheck-documentation-flag
                          '(defun t))))
 	     (beg (save-excursion (beginning-of-defun) (point)))
-	     (end (save-excursion (end-of-defun) (point)))
-	     (msg (checkdoc-this-string-valid)))
-	(if msg (if no-error
-		    (message "%s" (checkdoc-error-text msg))
-		  (error "%s" (checkdoc-error-text msg)))
-	  (setq msg (checkdoc-message-text-search beg end))
-	  (if msg (if no-error
-		      (message "%s" (checkdoc-error-text msg))
-		    (error "%s" (checkdoc-error-text msg)))
-	    (setq msg (checkdoc-rogue-space-check-engine beg end))
-	    (if msg (if no-error
-			(message "%s" (checkdoc-error-text msg))
-		      (error "%s" (checkdoc-error-text msg))))))
+	     (end (save-excursion (end-of-defun) (point))))
+        (dolist (fun (list #'checkdoc-this-string-valid
+                           (lambda () (checkdoc-message-text-search beg end))
+                           (lambda () (checkdoc-rogue-space-check-engine beg end))))
+          (let ((msg (funcall fun)))
+            (if msg (if no-error
+                        (message "%s" (checkdoc-error-text msg))
+                      (user-error "%s" (checkdoc-error-text msg))))))
 	(if (called-interactively-p 'interactive)
 	    (message "Checkdoc: done."))))))
 
@@ -1848,7 +1847,7 @@ Replace with \"%s\"? " original replace)
      ;; and reliance on the Ispell program.
      (checkdoc-ispell-docstring-engine e)
      ;; User supplied checks
-     (save-excursion (checkdoc-run-hooks 'checkdoc-style-hooks fp e))
+     (save-excursion (checkdoc-run-hooks 'checkdoc-style-functions fp e))
      ;; Done!
      )))
 
@@ -1943,7 +1942,7 @@ from the comment."
 A code fragment is identified by an open parenthesis followed by a
 symbol which is a valid function or a word in all CAPS, or a parenthesis
 that is quoted with the ' character.  Only the region from START to LIMIT
-is is allowed while searching for the bounding parenthesis."
+is allowed while searching for the bounding parenthesis."
   (save-match-data
     (save-restriction
       (narrow-to-region start limit)
@@ -2358,7 +2357,7 @@ Code:, and others referenced in the style guide."
        err
        (or
 	;; Generic Full-file checks (should be comment related)
-	(checkdoc-run-hooks 'checkdoc-comment-style-hooks)
+	(checkdoc-run-hooks 'checkdoc-comment-style-functions)
 	err))
       ;; Done with full file comment checks
       err)))
@@ -2644,12 +2643,6 @@ function called to create the messages."
 
 (custom-add-option 'emacs-lisp-mode-hook 'checkdoc-minor-mode)
 
-(add-to-list 'debug-ignored-errors
-	     "Argument `.*' should appear (as .*) in the doc string")
-(add-to-list 'debug-ignored-errors
-	     "Lisp symbol `.*' should appear in quotes")
-(add-to-list 'debug-ignored-errors "Disambiguate .* by preceding .*")
-
 (provide 'checkdoc)
 
 ;;; checkdoc.el ends here
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 8ea58b2e07c..7c25972835b 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -1,6 +1,6 @@
-;;; cl-extra.el --- Common Lisp features, part 2
+;;; cl-extra.el --- Common Lisp features, part 2  -*- lexical-binding: t -*-
 
-;; Copyright (C) 1993, 2000-2011  Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2000-2012 Free Software Foundation, Inc.
 
 ;; Author: Dave Gillespie <daveg@synaptics.com>
 ;; Keywords: extensions
@@ -37,12 +37,12 @@
 
 ;;; Code:
 
-(require 'cl)
+(require 'cl-lib)
 
 ;;; Type coercion.
 
 ;;;###autoload
-(defun coerce (x type)
+(defun cl-coerce (x type)
   "Coerce OBJECT to type TYPE.
 TYPE is a Common Lisp type specifier.
 \n(fn OBJECT TYPE)"
@@ -51,16 +51,16 @@ TYPE is a Common Lisp type specifier.
 	((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))
+	((and (eq type 'character) (symbolp x)) (cl-coerce (symbol-name x) type))
 	((eq type 'float) (float x))
-	((typep x type) x)
+	((cl-typep x type) x)
 	(t (error "Can't coerce %s to type %s" x type))))
 
 
 ;;; Predicates.
 
 ;;;###autoload
-(defun equalp (x y)
+(defun cl-equalp (x y)
   "Return 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
@@ -73,14 +73,14 @@ strings case-insensitively."
 	((numberp x)
 	 (and (numberp y) (= x y)))
 	((consp x)
-	 (while (and (consp x) (consp y) (equalp (car x) (car y)))
+	 (while (and (consp x) (consp y) (cl-equalp (car x) (car y)))
 	   (setq x (cdr x) y (cdr y)))
-	 (and (not (consp x)) (equalp x y)))
+	 (and (not (consp x)) (cl-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))))
+			    (cl-equalp (aref x i) (aref y i))))
 		(< i 0))))
 	(t (equal x y))))
 
@@ -88,7 +88,7 @@ strings case-insensitively."
 ;;; Control structures.
 
 ;;;###autoload
-(defun cl-mapcar-many (cl-func cl-seqs)
+(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)))
@@ -115,23 +115,23 @@ strings case-insensitively."
 	    (cl-i -1))
 	(while (< (setq cl-i (1+ cl-i)) cl-n)
 	  (push (funcall cl-func
-			    (if (consp cl-x) (pop cl-x) (aref cl-x cl-i))
-			    (if (consp cl-y) (pop cl-y) (aref cl-y cl-i)))
-		   cl-res)))
+                         (if (consp cl-x) (pop cl-x) (aref cl-x cl-i))
+                         (if (consp cl-y) (pop cl-y) (aref cl-y cl-i)))
+                cl-res)))
       (nreverse cl-res))))
 
 ;;;###autoload
-(defun map (cl-type cl-func cl-seq &rest cl-rest)
+(defun cl-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.
 \n(fn TYPE FUNCTION SEQUENCE...)"
-  (let ((cl-res (apply 'mapcar* cl-func cl-seq cl-rest)))
-    (and cl-type (coerce cl-res cl-type))))
+  (let ((cl-res (apply 'cl-mapcar cl-func cl-seq cl-rest)))
+    (and cl-type (cl-coerce cl-res cl-type))))
 
 ;;;###autoload
-(defun maplist (cl-func cl-list &rest cl-rest)
+(defun cl-maplist (cl-func cl-list &rest cl-rest)
   "Map FUNCTION to each sublist of LIST or LISTs.
-Like `mapcar', except applies to lists and their cdr's rather than to
+Like `cl-mapcar', except applies to lists and their cdr's rather than to
 the elements themselves.
 \n(fn FUNCTION LIST...)"
   (if cl-rest
@@ -149,44 +149,45 @@ the elements themselves.
 	(setq cl-list (cdr cl-list)))
       (nreverse cl-res))))
 
+;;;###autoload
 (defun cl-mapc (cl-func cl-seq &rest cl-rest)
-  "Like `mapcar', but does not accumulate values returned by the function.
+  "Like `cl-mapcar', but does not accumulate values returned by the function.
 \n(fn FUNCTION SEQUENCE...)"
   (if cl-rest
-      (progn (apply 'map nil cl-func cl-seq cl-rest)
+      (progn (apply 'cl-map nil cl-func cl-seq cl-rest)
 	     cl-seq)
     (mapc cl-func cl-seq)))
 
 ;;;###autoload
-(defun mapl (cl-func cl-list &rest cl-rest)
-  "Like `maplist', but does not accumulate values returned by the function.
+(defun cl-mapl (cl-func cl-list &rest cl-rest)
+  "Like `cl-maplist', but does not accumulate values returned by the function.
 \n(fn FUNCTION LIST...)"
   (if cl-rest
-      (apply 'maplist cl-func cl-list cl-rest)
+      (apply 'cl-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)
 
 ;;;###autoload
-(defun mapcan (cl-func cl-seq &rest cl-rest)
-  "Like `mapcar', but nconc's together the values returned by the function.
+(defun cl-mapcan (cl-func cl-seq &rest cl-rest)
+  "Like `cl-mapcar', but nconc's together the values returned by the function.
 \n(fn FUNCTION SEQUENCE...)"
-  (apply 'nconc (apply 'mapcar* cl-func cl-seq cl-rest)))
+  (apply 'nconc (apply 'cl-mapcar cl-func cl-seq cl-rest)))
 
 ;;;###autoload
-(defun mapcon (cl-func cl-list &rest cl-rest)
-  "Like `maplist', but nconc's together the values returned by the function.
+(defun cl-mapcon (cl-func cl-list &rest cl-rest)
+  "Like `cl-maplist', but nconc's together the values returned by the function.
 \n(fn FUNCTION LIST...)"
-  (apply 'nconc (apply 'maplist cl-func cl-list cl-rest)))
+  (apply 'nconc (apply 'cl-maplist cl-func cl-list cl-rest)))
 
 ;;;###autoload
-(defun some (cl-pred cl-seq &rest cl-rest)
+(defun cl-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.
 \n(fn PREDICATE SEQ...)"
   (if (or cl-rest (nlistp cl-seq))
       (catch 'cl-some
-	(apply 'map nil
+	(apply 'cl-map nil
 	       (function (lambda (&rest cl-x)
 			   (let ((cl-res (apply cl-pred cl-x)))
 			     (if cl-res (throw 'cl-some cl-res)))))
@@ -196,12 +197,12 @@ If so, return the true (non-nil) value returned by PREDICATE.
       cl-x)))
 
 ;;;###autoload
-(defun every (cl-pred cl-seq &rest cl-rest)
+(defun cl-every (cl-pred cl-seq &rest cl-rest)
   "Return true if PREDICATE is true of every element of SEQ or SEQs.
 \n(fn PREDICATE SEQ...)"
   (if (or cl-rest (nlistp cl-seq))
       (catch 'cl-every
-	(apply 'map nil
+	(apply 'cl-map nil
 	       (function (lambda (&rest cl-x)
 			   (or (apply cl-pred cl-x) (throw 'cl-every nil))))
 	       cl-seq cl-rest) t)
@@ -210,23 +211,19 @@ If so, return the true (non-nil) value returned by PREDICATE.
     (null cl-seq)))
 
 ;;;###autoload
-(defun notany (cl-pred cl-seq &rest cl-rest)
+(defun cl-notany (cl-pred cl-seq &rest cl-rest)
   "Return true if PREDICATE is false of every element of SEQ or SEQs.
 \n(fn PREDICATE SEQ...)"
-  (not (apply 'some cl-pred cl-seq cl-rest)))
+  (not (apply 'cl-some cl-pred cl-seq cl-rest)))
 
 ;;;###autoload
-(defun notevery (cl-pred cl-seq &rest cl-rest)
+(defun cl-notevery (cl-pred cl-seq &rest cl-rest)
   "Return true if PREDICATE is false of some element of SEQ or SEQs.
 \n(fn PREDICATE SEQ...)"
-  (not (apply 'every cl-pred cl-seq cl-rest)))
-
-;;; Support for `loop'.
-;;;###autoload
-(defalias 'cl-map-keymap 'map-keymap)
+  (not (apply 'cl-every cl-pred cl-seq cl-rest)))
 
 ;;;###autoload
-(defun cl-map-keymap-recursively (cl-func-rec cl-map &optional cl-base)
+(defun cl--map-keymap-recursively (cl-func-rec cl-map &optional cl-base)
   (or cl-base
       (setq cl-base (copy-sequence [0])))
   (map-keymap
@@ -234,14 +231,14 @@ If so, return the true (non-nil) value returned by PREDICATE.
     (lambda (cl-key cl-bind)
       (aset cl-base (1- (length cl-base)) cl-key)
       (if (keymapp cl-bind)
-	  (cl-map-keymap-recursively
+	  (cl--map-keymap-recursively
 	   cl-func-rec cl-bind
 	   (vconcat cl-base (list 0)))
 	(funcall cl-func-rec cl-base cl-bind))))
    cl-map))
 
 ;;;###autoload
-(defun cl-map-intervals (cl-func &optional cl-what cl-prop cl-start cl-end)
+(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)
@@ -269,7 +266,7 @@ If so, return the true (non-nil) value returned by PREDICATE.
 	(setq cl-start cl-next)))))
 
 ;;;###autoload
-(defun cl-map-overlays (cl-func &optional cl-buffer cl-start cl-end cl-arg)
+(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)
 
@@ -311,36 +308,17 @@ If so, return the true (non-nil) value returned by PREDICATE.
 
 ;;; Support for `setf'.
 ;;;###autoload
-(defun cl-set-frame-visible-p (frame val)
+(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)
-;;;###autoload
-(defun cl-progv-before (syms values)
-  (while syms
-    (push (if (boundp (car syms))
-		 (cons (car syms) (symbol-value (car syms)))
-	       (car syms)) cl-progv-save)
-    (if values
-	(set (pop syms) (pop values))
-      (makunbound (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)))
-    (pop cl-progv-save)))
-
 
 ;;; Numbers.
 
 ;;;###autoload
-(defun gcd (&rest args)
+(defun cl-gcd (&rest args)
   "Return the greatest common divisor of the arguments."
   (let ((a (abs (or (pop args) 0))))
     (while args
@@ -349,18 +327,18 @@ If so, return the true (non-nil) value returned by PREDICATE.
     a))
 
 ;;;###autoload
-(defun lcm (&rest args)
+(defun cl-lcm (&rest args)
   "Return the least common multiple of the arguments."
   (if (memq 0 args)
       0
     (let ((a (abs (or (pop args) 1))))
       (while args
 	(let ((b (abs (pop args))))
-	  (setq a (* (/ a (gcd a b)) b))))
+	  (setq a (* (/ a (cl-gcd a b)) b))))
       a)))
 
 ;;;###autoload
-(defun isqrt (x)
+(defun cl-isqrt (x)
   "Return the integer square root of the argument."
   (if (and (integerp x) (> x 0))
       (let ((g (cond ((<= x 100) 10) ((<= x 10000) 100)
@@ -372,35 +350,35 @@ If so, return the true (non-nil) value returned by PREDICATE.
     (if (eq x 0) 0 (signal 'arith-error nil))))
 
 ;;;###autoload
-(defun floor* (x &optional y)
+(defun cl-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)))))
 
 ;;;###autoload
-(defun ceiling* (x &optional y)
+(defun cl-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)))
+  (let ((res (cl-floor x y)))
     (if (= (car (cdr res)) 0) res
       (list (1+ (car res)) (- (car (cdr res)) (or y 1))))))
 
 ;;;###autoload
-(defun truncate* (x &optional y)
+(defun cl-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)))
+      (cl-floor x y) (cl-ceiling x y)))
 
 ;;;###autoload
-(defun round* (x &optional y)
+(defun cl-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)))
+		 (res (cl-floor (+ x hy) y)))
 	    (if (and (= (car (cdr res)) 0)
 		     (= (+ hy hy) y)
 		     (/= (% (car res) 2) 0))
@@ -413,29 +391,28 @@ With two arguments, return rounding and remainder of their quotient."
 	(list q (- x q))))))
 
 ;;;###autoload
-(defun mod* (x y)
+(defun cl-mod (x y)
   "The remainder of X divided by Y, with the same sign as Y."
-  (nth 1 (floor* x y)))
+  (nth 1 (cl-floor x y)))
 
 ;;;###autoload
-(defun rem* (x y)
+(defun cl-rem (x y)
   "The remainder of X divided by Y, with the same sign as X."
-  (nth 1 (truncate* x y)))
+  (nth 1 (cl-truncate x y)))
 
 ;;;###autoload
-(defun signum (x)
+(defun cl-signum (x)
   "Return 1 if X is positive, -1 if negative, 0 if zero."
   (cond ((> x 0) 1) ((< x 0) -1) (t 0)))
 
 
 ;; Random numbers.
 
-(defvar *random-state*)
 ;;;###autoload
-(defun random* (lim &optional state)
+(defun cl-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*))
+  (or state (setq state cl--random-state))
   ;; Inspired by "ran3" from Numerical Recipes.  Additive congruential method.
   (let ((vec (aref state 3)))
     (if (integerp vec)
@@ -444,29 +421,29 @@ Optional second arg STATE is a random-state object."
 	  (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))))
+	  (while (< (setq i (1+ i)) 200) (cl-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))))
+	    (if (> lim 8388607) (setq n (+ (lsh n 9) (cl-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))))
+	      (if (< (setq n (logand n mask)) lim) n (cl-random lim state))))
 	(* (/ n '8388608e0) lim)))))
 
 ;;;###autoload
-(defun make-random-state (&optional state)
-  "Return a copy of random-state STATE, or of `*random-state*' if omitted.
+(defun cl-make-random-state (&optional state)
+  "Return a copy of random-state STATE, or of the internal 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))
+  (cond ((null state) (cl-make-random-state cl--random-state))
+	((vectorp state) (copy-tree state t))
 	((integerp state) (vector 'cl-random-state-tag -1 30 state))
-	(t (make-random-state (cl-random-time)))))
+	(t (cl-make-random-state (cl--random-time)))))
 
 ;;;###autoload
-(defun random-state-p (object)
+(defun cl-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)))
@@ -474,8 +451,8 @@ If STATE is t, return a new state object seeded from the time of day."
 
 ;; Implementation limits.
 
-(defun cl-finite-do (func a b)
-  (condition-case err
+(defun cl--finite-do (func a b)
+  (condition-case _
       (let ((res (funcall func a b)))   ; check for IEEE infinity
 	(and (numberp res) (/= res (/ res 2)) res))
     (arith-error nil)))
@@ -483,51 +460,55 @@ If STATE is t, return a new state object seeded from the time of day."
 ;;;###autoload
 (defun cl-float-limits ()
   "Initialize the Common Lisp floating-point parameters.
-This sets the values of: `most-positive-float', `most-negative-float',
-`least-positive-float', `least-negative-float', `float-epsilon',
-`float-negative-epsilon', `least-positive-normalized-float', and
-`least-negative-normalized-float'."
-  (or most-positive-float (not (numberp '2e1))
+This sets the values of: `cl-most-positive-float', `cl-most-negative-float',
+`cl-least-positive-float', `cl-least-negative-float', `cl-float-epsilon',
+`cl-float-negative-epsilon', `cl-least-positive-normalized-float', and
+`cl-least-negative-normalized-float'."
+  (or cl-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)))
+	(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))
+	;; Now cl-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))
+	(setq cl-most-positive-float x
+	      cl-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))
+	(while (condition-case _ (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))
+	(setq cl-least-positive-normalized-float y
+	      cl-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))
+	(while (condition-case _ (> (/ x 2) 0) (arith-error nil))
 	  (setq x (/ x 2)))
-	(setq least-positive-float x
-	      least-negative-float (- x))
+	(setq cl-least-positive-float x
+	      cl-least-negative-float (- x))
 	(setq x '1e0)
 	(while (/= (+ '1e0 x) '1e0) (setq x (/ x 2)))
-	(setq float-epsilon (* x 2))
+	(setq cl-float-epsilon (* x 2))
 	(setq x '1e0)
 	(while (/= (- '1e0 x) '1e0) (setq x (/ x 2)))
-	(setq float-negative-epsilon (* x 2))))
+	(setq cl-float-negative-epsilon (* x 2))))
   nil)
 
 
 ;;; Sequence functions.
 
 ;;;###autoload
-(defun subseq (seq start &optional end)
+(defun cl-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."
+  (declare (gv-setter
+            (lambda (new)
+              `(progn (cl-replace ,seq ,new :start1 ,start :end1 ,end)
+                      ,new))))
   (if (stringp seq) (substring seq start end)
     (let (len)
       (and end (< end 0) (setq end (+ end (setq len (length seq)))))
@@ -550,7 +531,7 @@ If START or END is negative, it counts from the end."
 	       res))))))
 
 ;;;###autoload
-(defun concatenate (type &rest seqs)
+(defun cl-concatenate (type &rest seqs)
   "Concatenate, into a sequence of type TYPE, the argument SEQUENCEs.
 \n(fn TYPE SEQUENCE...)"
   (cond ((eq type 'vector) (apply 'vconcat seqs))
@@ -562,17 +543,17 @@ If START or END is negative, it counts from the end."
 ;;; List functions.
 
 ;;;###autoload
-(defun revappend (x y)
+(defun cl-revappend (x y)
   "Equivalent to (append (reverse X) Y)."
   (nconc (reverse x) y))
 
 ;;;###autoload
-(defun nreconc (x y)
+(defun cl-nreconc (x y)
   "Equivalent to (nconc (nreverse X) Y)."
   (nconc (nreverse x) y))
 
 ;;;###autoload
-(defun list-length (x)
+(defun cl-list-length (x)
   "Return the length of list X.  Return nil if list is circular."
   (let ((n 0) (fast x) (slow x))
     (while (and (cdr fast) (not (and (eq fast slow) (> n 0))))
@@ -580,51 +561,62 @@ If START or END is negative, it counts from the end."
     (if fast (if (cdr fast) nil (1+ n)) n)))
 
 ;;;###autoload
-(defun tailp (sublist list)
+(defun cl-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)))
 
-(defalias 'cl-copy-tree 'copy-tree)
-
-
 ;;; Property lists.
 
 ;;;###autoload
-(defun get* (sym tag &optional def)    ; See compiler macro in cl-macs.el
+(defun cl-get (sym tag &optional def)
   "Return the value of SYMBOL's PROPNAME property, or DEFAULT if none.
 \n(fn SYMBOL PROPNAME &optional DEFAULT)"
+  (declare (compiler-macro cl--compiler-macro-get)
+           (gv-setter (lambda (store) `(put ,sym ,tag ,store))))
   (or (get sym tag)
       (and def
+           ;; Make sure `def' is really absent as opposed to set to nil.
 	   (let ((plist (symbol-plist sym)))
 	     (while (and plist (not (eq (car plist) tag)))
 	       (setq plist (cdr (cdr plist))))
 	     (if plist (car (cdr plist)) def)))))
+(autoload 'cl--compiler-macro-get "cl-macs")
 
 ;;;###autoload
-(defun getf (plist tag &optional def)
+(defun cl-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'.
 \n(fn PROPLIST PROPNAME &optional DEFAULT)"
+  (declare (gv-expander
+            (lambda (do)
+              (gv-letplace (getter setter) plist
+                (macroexp-let2 nil k tag
+                  (macroexp-let2 nil d def
+                    (funcall do `(cl-getf ,getter ,k ,d)
+                             (lambda (v)
+                               (funcall setter
+                                        `(cl--set-getf ,getter ,k ,v))))))))))
   (setplist '--cl-getf-symbol-- plist)
   (or (get '--cl-getf-symbol-- tag)
-      ;; Originally we called get* here,
-      ;; but that fails, because get* has a compiler macro
+      ;; Originally we called cl-get here,
+      ;; but that fails, because cl-get has a compiler macro
       ;; definition that uses getf!
       (when def
+        ;; Make sure `def' is really absent as opposed to set to nil.
 	(while (and plist (not (eq (car plist) tag)))
 	  (setq plist (cdr (cdr plist))))
 	(if plist (car (cdr plist)) def))))
 
 ;;;###autoload
-(defun cl-set-getf (plist tag val)
+(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))))
+    (if p (progn (setcar (cdr p) val) plist) (cl-list* tag val plist))))
 
 ;;;###autoload
-(defun cl-do-remf (plist tag)
+(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))))
@@ -636,41 +628,7 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
   (let ((plist (symbol-plist sym)))
     (if (and plist (eq tag (car plist)))
 	(progn (setplist sym (cdr (cdr plist))) t)
-      (cl-do-remf plist tag))))
-;;;###autoload
-(defalias 'remprop 'cl-remprop)
-
-
-
-;;; Hash tables.
-;; This is just kept for compatibility with code byte-compiled by Emacs-20.
-
-;; No idea if this might still be needed.
-(defun cl-not-hash-table (x &optional y &rest z)
-  (signal 'wrong-type-argument (list 'cl-hash-table-p (or y x))))
-
-(defvar cl-builtin-gethash (symbol-function 'gethash))
-(defvar cl-builtin-remhash (symbol-function 'remhash))
-(defvar cl-builtin-clrhash (symbol-function 'clrhash))
-(defvar cl-builtin-maphash (symbol-function 'maphash))
-
-;;;###autoload
-(defalias 'cl-gethash 'gethash)
-;;;###autoload
-(defalias 'cl-puthash 'puthash)
-;;;###autoload
-(defalias 'cl-remhash 'remhash)
-;;;###autoload
-(defalias 'cl-clrhash 'clrhash)
-;;;###autoload
-(defalias 'cl-maphash 'maphash)
-;; These three actually didn't exist in Emacs-20.
-;;;###autoload
-(defalias 'cl-make-hash-table 'make-hash-table)
-;;;###autoload
-(defalias 'cl-hash-table-p 'hash-table-p)
-;;;###autoload
-(defalias 'cl-hash-table-count 'hash-table-count)
+      (cl--do-remf plist tag))))
 
 ;;; Some debugging aids.
 
@@ -686,15 +644,15 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
       (forward-sexp)
       (delete-char 1))
     (goto-char (1+ pt))
-    (cl-do-prettyprint)))
+    (cl--do-prettyprint)))
 
-(defun 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 ")))
+		      (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] ")))
@@ -704,104 +662,27 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
 		  (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))
+	      (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))
+		(cl--do-prettyprint))
 	      (forward-char 1))))
     (forward-sexp)))
 
-(defvar cl-macroexpand-cmacs nil)
-(defvar cl-closure-vars nil)
-
-;;;###autoload
-(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
-	       (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))
-		       (push (list 'quote (pop body)) decls))
-		     (put (car (last cl-closure-vars)) 'used t)
-                     `(list 'lambda '(&rest --cl-rest--)
-                            ,@(sublis sub (nreverse decls))
-                            (list 'apply
-                                  (list 'quote
-                                        #'(lambda ,(append new (cadadr form))
-                                            ,@(sublis sub body)))
-                                  ,@(nconc (mapcar (lambda (x) `(list 'quote ,x))
-                                                   cl-closure-vars)
-                                           '((quote --cl-rest--))))))
-		 (list (car form) (list* 'lambda (cadadr form) body))))
-	   (let ((found (assq (cadr form) env)))
-	     (if (and found (ignore-errors
-			      (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))))
-        ((consp (car form))
-         (cl-macroexpand-all (list* 'funcall
-                                    (list 'function (car form))
-                                    (cdr form))
-                             env))
-	(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))
-
 ;;;###autoload
 (defun cl-prettyexpand (form &optional full)
+  "Expand macros in FORM and insert the pretty-printed result.
+Optional argument FULL non-nil means to expand all macros,
+including `cl-block' and `cl-eval-when'."
   (message "Expanding...")
-  (let ((cl-macroexpand-cmacs full) (cl-compiling-file full)
+  (let ((cl--compiling-file full)
 	(byte-compile-macro-environment nil))
-    (setq form (cl-macroexpand-all form
-				   (and (not full) '((block) (eval-when)))))
+    (setq form (macroexpand-all form
+                                (and (not full) '((cl-block) (cl-eval-when)))))
     (message "Formatting...")
     (prog1 (cl-prettyprint form)
       (message ""))))
@@ -812,7 +693,6 @@ This also does some trivial optimizations to make the form prettier."
 
 ;; Local variables:
 ;; byte-compile-dynamic: t
-;; byte-compile-warnings: (not cl-functions)
 ;; generated-autoload-file: "cl-loaddefs.el"
 ;; End:
 
diff --git a/lisp/emacs-lisp/cl-indent.el b/lisp/emacs-lisp/cl-indent.el
index 81af2030ebe..01bdfbf4bf2 100644
--- a/lisp/emacs-lisp/cl-indent.el
+++ b/lisp/emacs-lisp/cl-indent.el
@@ -1,6 +1,6 @@
 ;;; cl-indent.el --- enhanced lisp-indent mode
 
-;; Copyright (C) 1987, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1987, 2000-2012 Free Software Foundation, Inc.
 
 ;; Author: Richard Mlynarik <mly@eddie.mit.edu>
 ;; Created: July 1987
@@ -104,6 +104,7 @@ If non-nil, alignment is done with the first keyword
 \(defun foo (arg1 arg2 &rest rest
                       &key key1 key2)
   #|...|#)"
+  :version "24.1"
   :type 'boolean
   :group 'lisp-indent)
 
@@ -111,6 +112,7 @@ If non-nil, alignment is done with the first keyword
   "Indentation of lambda list keyword parameters.
 See `lisp-lambda-list-keyword-parameter-alignment'
 for more information."
+  :version "24.1"
   :type 'integer
   :group 'lisp-indent)
 
@@ -130,6 +132,7 @@ If non-nil, alignment is done with the first parameter
 \(defun foo (arg1 arg2 &key key1 key2
                             key3 key4)
   #|...|#)"
+  :version "24.1"
   :type 'boolean
   :group 'lisp-indent)
 
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
new file mode 100644
index 00000000000..d5e5f4bbfbc
--- /dev/null
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -0,0 +1,756 @@
+;;; cl-lib.el --- Common Lisp extensions for Emacs  -*- lexical-binding: t -*-
+
+;; Copyright (C) 1993, 2001-2012  Free Software Foundation, Inc.
+
+;; Author: Dave Gillespie <daveg@synaptics.com>
+;; Version: 1.0
+;; 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 3 of the License, 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.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; 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.
+;;
+;; 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:
+
+(require 'macroexp)
+
+(defvar cl-optimize-speed 1)
+(defvar cl-optimize-safety 1)
+
+;;;###autoload
+(define-obsolete-variable-alias
+  ;; This alias is needed for compatibility with .elc files that use defstruct
+  ;; and were compiled with Emacs<24.3.
+  'custom-print-functions 'cl-custom-print-functions "24.3")
+
+;;;###autoload
+(defvar cl-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.")
+
+(defun cl-unload-function ()
+  "Stop unloading of the Common Lisp extensions."
+  (message "Cannot unload the feature `cl'")
+  ;; Stop standard unloading!
+  t)
+
+;;; Generalized variables.
+;; These macros are defined here so that they
+;; can safely be used in init files.
+
+(defmacro cl-incf (place &optional 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."
+  (declare (debug (place &optional form)))
+  (if (symbolp place)
+      (list 'setq place (if x (list '+ place x) (list '1+ place)))
+    (list 'cl-callf '+ place (or x 1))))
+
+(defmacro cl-decf (place &optional 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."
+  (declare (debug cl-incf))
+  (if (symbolp place)
+      (list 'setq place (if x (list '- place x) (list '1- place)))
+    (list 'cl-callf '- place (or x 1))))
+
+(defmacro cl-pushnew (x place &rest keys)
+  "(cl-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.
+\nKeywords supported:  :test :test-not :key
+\n(fn X PLACE [KEYWORD VALUE]...)"
+  (declare (debug
+            (form place &rest
+                  &or [[&or ":test" ":test-not" ":key"] function-form]
+                  [keywordp form])))
+  (if (symbolp place)
+      (if (null keys)
+          (macroexp-let2 nil var x
+            `(if (memql ,var ,place)
+                 ;; This symbol may later on expand to actual code which then
+                 ;; trigger warnings like "value unused" since cl-pushnew's
+                 ;; return value is rarely used.  It should not matter that
+                 ;; other warnings may be silenced, since `place' is used
+                 ;; earlier and should have triggered them already.
+                 (with-no-warnings ,place)
+               (setq ,place (cons ,var ,place))))
+	(list 'setq place (cl-list* 'cl-adjoin x place keys)))
+    (cl-list* 'cl-callf2 'cl-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-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) (cl-incf end (length str)))
+    (setq end (length str)))
+  (if (< start 0) (cl-incf start (length str)))
+  (concat (and (> start 0) (substring str 0 start))
+	  val
+	  (and (< end (length str)) (substring str end))))
+
+
+;;; 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, cl-multiple-value-bind and friends simply expect
+;; the target form to return the values as a list.
+
+(defun cl--defalias (cl-f el-f &optional doc)
+  (defalias cl-f el-f doc)
+  (put cl-f 'byte-optimizer 'byte-compile-inline-expand))
+
+(cl--defalias 'cl-values #'list
+  "Return multiple values, Common Lisp style.
+The arguments of `cl-values' are the values
+that the containing function should return.
+
+\(fn &rest VALUES)")
+
+(cl--defalias 'cl-values-list #'identity
+  "Return multiple values, Common Lisp style, taken from a list.
+LIST specifies the list of values
+that the containing function should return.
+
+\(fn LIST)")
+
+(defsubst cl-multiple-value-list (expression)
+  "Return a list of the multiple values produced by EXPRESSION.
+This handles multiple values in Common Lisp style, but it does not
+work right when EXPRESSION calls an ordinary Emacs Lisp function
+that returns just one value."
+  expression)
+
+(defsubst cl-multiple-value-apply (function expression)
+  "Evaluate EXPRESSION to get multiple values and apply FUNCTION to them.
+This handles multiple values in Common Lisp style, but it does not work
+right when EXPRESSION calls an ordinary Emacs Lisp function that returns just
+one value."
+  (apply function expression))
+
+(defalias 'cl-multiple-value-call 'apply
+  "Apply FUNCTION to ARGUMENTS, taking multiple values into account.
+This implementation only handles the case where there is only one argument.")
+
+(cl--defalias 'cl-nth-value #'nth
+  "Evaluate EXPRESSION to get multiple values and return the Nth one.
+This handles multiple values in Common Lisp style, but it does not work
+right when EXPRESSION calls an ordinary Emacs Lisp function that returns just
+one value.
+
+\(fn N EXPRESSION)")
+
+;;; Declarations.
+
+(defvar cl--compiling-file nil)
+(defun cl--compiling-file ()
+  (or cl--compiling-file
+      (and (boundp 'byte-compile--outbuffer)
+           (bufferp (symbol-value 'byte-compile--outbuffer))
+	   (equal (buffer-name (symbol-value 'byte-compile--outbuffer))
+		  " *Compiler Output*"))))
+
+(defvar cl-proclaims-deferred nil)
+
+(defun cl-proclaim (spec)
+  "Record a global declaration specified by SPEC."
+  (if (fboundp 'cl-do-proclaim) (cl-do-proclaim spec t)
+    (push spec cl-proclaims-deferred))
+  nil)
+
+(defmacro cl-declaim (&rest specs)
+  "Like `cl-proclaim', but takes any number of unevaluated, unquoted arguments.
+Puts `(cl-eval-when (compile load eval) ...)' around the declarations
+so that they are registered at compile-time as well as run-time."
+  (let ((body (mapcar (function (lambda (x)
+                                  (list 'cl-proclaim (list 'quote x))))
+		      specs)))
+    (if (cl--compiling-file) (cl-list* 'cl-eval-when '(compile load eval) body)
+      (cons 'progn body))))   ; avoid loading cl-macs.el for cl-eval-when
+
+
+;;; Symbols.
+
+(defun cl--random-time ()
+  (let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0))
+    (while (>= (cl-decf i) 0) (setq v (+ (* v 3) (aref time i))))
+    v))
+
+(defvar cl--gensym-counter (* (logand (cl--random-time) 1023) 100))
+
+
+;;; Numbers.
+
+(defun cl-floatp-safe (object)
+  "Return t if OBJECT is a floating point number.
+On Emacs versions that lack floating-point support, this function
+always returns nil."
+  (and (numberp object) (not (integerp object))))
+
+(defsubst cl-plusp (number)
+  "Return t if NUMBER is positive."
+  (> number 0))
+
+(defsubst cl-minusp (number)
+  "Return t if NUMBER is negative."
+  (< number 0))
+
+(defun cl-oddp (integer)
+  "Return t if INTEGER is odd."
+  (eq (logand integer 1) 1))
+
+(defun cl-evenp (integer)
+  "Return t if INTEGER is even."
+  (eq (logand integer 1) 0))
+
+(defvar cl--random-state (vector 'cl-random-state-tag -1 30 (cl--random-time)))
+
+(defconst cl-most-positive-float nil
+  "The largest value that a Lisp float can hold.
+If your system supports infinities, this is the largest finite value.
+For IEEE machines, this is approximately 1.79e+308.
+Call `cl-float-limits' to set this.")
+
+(defconst cl-most-negative-float nil
+  "The largest negative value that a Lisp float can hold.
+This is simply -`cl-most-positive-float'.
+Call `cl-float-limits' to set this.")
+
+(defconst cl-least-positive-float nil
+  "The smallest value greater than zero that a Lisp float can hold.
+For IEEE machines, it is about 4.94e-324 if denormals are supported,
+or 2.22e-308 if they are not.
+Call `cl-float-limits' to set this.")
+
+(defconst cl-least-negative-float nil
+  "The smallest value less than zero that a Lisp float can hold.
+This is simply -`cl-least-positive-float'.
+Call `cl-float-limits' to set this.")
+
+(defconst cl-least-positive-normalized-float nil
+  "The smallest normalized Lisp float greater than zero.
+This is the smallest value for which IEEE denormalization does not lose
+precision.  For IEEE machines, this value is about 2.22e-308.
+For machines that do not support the concept of denormalization
+and gradual underflow, this constant equals `cl-least-positive-float'.
+Call `cl-float-limits' to set this.")
+
+(defconst cl-least-negative-normalized-float nil
+  "The smallest normalized Lisp float less than zero.
+This is simply -`cl-least-positive-normalized-float'.
+Call `cl-float-limits' to set this.")
+
+(defconst cl-float-epsilon nil
+  "The smallest positive float that adds to 1.0 to give a distinct value.
+Adding a number less than this to 1.0 returns 1.0 due to roundoff.
+For IEEE machines, epsilon is about 2.22e-16.
+Call `cl-float-limits' to set this.")
+
+(defconst cl-float-negative-epsilon nil
+  "The smallest positive float that subtracts from 1.0 to give a distinct value.
+For IEEE machines, it is about 1.11e-16.
+Call `cl-float-limits' to set this.")
+
+
+;;; Sequence functions.
+
+(cl--defalias 'cl-copy-seq 'copy-sequence)
+
+(declare-function cl--mapcar-many "cl-extra" (cl-func cl-seqs))
+
+(defun cl-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.
+\n(fn FUNCTION SEQ...)"
+  (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)))
+
+(cl--defalias 'cl-svref 'aref)
+
+;;; List functions.
+
+(cl--defalias 'cl-first 'car)
+(cl--defalias 'cl-second 'cadr)
+(cl--defalias 'cl-rest 'cdr)
+(cl--defalias 'cl-endp 'null)
+
+(cl--defalias 'cl-third 'cl-caddr "Return the third element of the list X.")
+(cl--defalias 'cl-fourth 'cl-cadddr "Return the fourth element of the list X.")
+
+(defsubst cl-fifth (x)
+  "Return the fifth element of the list X."
+  (declare (gv-setter (lambda (store) `(setcar (nthcdr 4 ,x) ,store))))
+  (nth 4 x))
+
+(defsubst cl-sixth (x)
+  "Return the sixth element of the list X."
+  (declare (gv-setter (lambda (store) `(setcar (nthcdr 5 ,x) ,store))))
+  (nth 5 x))
+
+(defsubst cl-seventh (x)
+  "Return the seventh element of the list X."
+  (declare (gv-setter (lambda (store) `(setcar (nthcdr 6 ,x) ,store))))
+  (nth 6 x))
+
+(defsubst cl-eighth (x)
+  "Return the eighth element of the list X."
+  (declare (gv-setter (lambda (store) `(setcar (nthcdr 7 ,x) ,store))))
+  (nth 7 x))
+
+(defsubst cl-ninth (x)
+  "Return the ninth element of the list X."
+  (declare (gv-setter (lambda (store) `(setcar (nthcdr 8 ,x) ,store))))
+  (nth 8 x))
+
+(defsubst cl-tenth (x)
+  "Return the tenth element of the list X."
+  (declare (gv-setter (lambda (store) `(setcar (nthcdr 9 ,x) ,store))))
+  (nth 9 x))
+
+(defun cl-caaar (x)
+  "Return the `car' of the `car' of the `car' of X."
+  (declare (compiler-macro cl--compiler-macro-cXXr))
+  (car (car (car x))))
+
+(defun cl-caadr (x)
+  "Return the `car' of the `car' of the `cdr' of X."
+  (declare (compiler-macro cl--compiler-macro-cXXr))
+  (car (car (cdr x))))
+
+(defun cl-cadar (x)
+  "Return the `car' of the `cdr' of the `car' of X."
+  (declare (compiler-macro cl--compiler-macro-cXXr))
+  (car (cdr (car x))))
+
+(defun cl-caddr (x)
+  "Return the `car' of the `cdr' of the `cdr' of X."
+  (declare (compiler-macro cl--compiler-macro-cXXr))
+  (car (cdr (cdr x))))
+
+(defun cl-cdaar (x)
+  "Return the `cdr' of the `car' of the `car' of X."
+  (declare (compiler-macro cl--compiler-macro-cXXr))
+  (cdr (car (car x))))
+
+(defun cl-cdadr (x)
+  "Return the `cdr' of the `car' of the `cdr' of X."
+  (declare (compiler-macro cl--compiler-macro-cXXr))
+  (cdr (car (cdr x))))
+
+(defun cl-cddar (x)
+  "Return the `cdr' of the `cdr' of the `car' of X."
+  (declare (compiler-macro cl--compiler-macro-cXXr))
+  (cdr (cdr (car x))))
+
+(defun cl-cdddr (x)
+  "Return the `cdr' of the `cdr' of the `cdr' of X."
+  (declare (compiler-macro cl--compiler-macro-cXXr))
+  (cdr (cdr (cdr x))))
+
+(defun cl-caaaar (x)
+  "Return the `car' of the `car' of the `car' of the `car' of X."
+  (declare (compiler-macro cl--compiler-macro-cXXr))
+  (car (car (car (car x)))))
+
+(defun cl-caaadr (x)
+  "Return the `car' of the `car' of the `car' of the `cdr' of X."
+  (declare (compiler-macro cl--compiler-macro-cXXr))
+  (car (car (car (cdr x)))))
+
+(defun cl-caadar (x)
+  "Return the `car' of the `car' of the `cdr' of the `car' of X."
+  (declare (compiler-macro cl--compiler-macro-cXXr))
+  (car (car (cdr (car x)))))
+
+(defun cl-caaddr (x)
+  "Return the `car' of the `car' of the `cdr' of the `cdr' of X."
+  (declare (compiler-macro cl--compiler-macro-cXXr))
+  (car (car (cdr (cdr x)))))
+
+(defun cl-cadaar (x)
+  "Return the `car' of the `cdr' of the `car' of the `car' of X."
+  (declare (compiler-macro cl--compiler-macro-cXXr))
+  (car (cdr (car (car x)))))
+
+(defun cl-cadadr (x)
+  "Return the `car' of the `cdr' of the `car' of the `cdr' of X."
+  (declare (compiler-macro cl--compiler-macro-cXXr))
+  (car (cdr (car (cdr x)))))
+
+(defun cl-caddar (x)
+  "Return the `car' of the `cdr' of the `cdr' of the `car' of X."
+  (declare (compiler-macro cl--compiler-macro-cXXr))
+  (car (cdr (cdr (car x)))))
+
+(defun cl-cadddr (x)
+  "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X."
+  (declare (compiler-macro cl--compiler-macro-cXXr))
+  (car (cdr (cdr (cdr x)))))
+
+(defun cl-cdaaar (x)
+  "Return the `cdr' of the `car' of the `car' of the `car' of X."
+  (declare (compiler-macro cl--compiler-macro-cXXr))
+  (cdr (car (car (car x)))))
+
+(defun cl-cdaadr (x)
+  "Return the `cdr' of the `car' of the `car' of the `cdr' of X."
+  (declare (compiler-macro cl--compiler-macro-cXXr))
+  (cdr (car (car (cdr x)))))
+
+(defun cl-cdadar (x)
+  "Return the `cdr' of the `car' of the `cdr' of the `car' of X."
+  (declare (compiler-macro cl--compiler-macro-cXXr))
+  (cdr (car (cdr (car x)))))
+
+(defun cl-cdaddr (x)
+  "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X."
+  (declare (compiler-macro cl--compiler-macro-cXXr))
+  (cdr (car (cdr (cdr x)))))
+
+(defun cl-cddaar (x)
+  "Return the `cdr' of the `cdr' of the `car' of the `car' of X."
+  (declare (compiler-macro cl--compiler-macro-cXXr))
+  (cdr (cdr (car (car x)))))
+
+(defun cl-cddadr (x)
+  "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X."
+  (declare (compiler-macro cl--compiler-macro-cXXr))
+  (cdr (cdr (car (cdr x)))))
+
+(defun cl-cdddar (x)
+  "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X."
+  (declare (compiler-macro cl--compiler-macro-cXXr))
+  (cdr (cdr (cdr (car x)))))
+
+(defun cl-cddddr (x)
+  "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X."
+  (declare (compiler-macro cl--compiler-macro-cXXr))
+  (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) (cl-incf m) (pop p))
+;;	(if (<= n 0) p
+;;	  (if (< n m) (nthcdr (- m n) x) x)))
+;;    (while (consp (cdr x)) (pop x))
+;;    x))
+
+(defun cl-list* (arg &rest rest)
+  "Return a new list with specified ARGs as elements, consed to last ARG.
+Thus, `(cl-list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
+`(cons A (cons B (cons C D)))'.
+\n(fn ARG...)"
+  (declare (compiler-macro cl--compiler-macro-list*))
+  (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 cl-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 cl-copy-list (list)
+  "Return a copy of LIST, which may be a dotted list.
+The elements of 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)))
+
+;; Autoloaded, but we have not loaded cl-loaddefs yet.
+(declare-function cl-floor "cl-extra" (x &optional y))
+(declare-function cl-ceiling "cl-extra" (x &optional y))
+(declare-function cl-truncate "cl-extra" (x &optional y))
+(declare-function cl-round "cl-extra" (x &optional y))
+(declare-function cl-mod "cl-extra" (x y))
+
+(defun cl-adjoin (cl-item cl-list &rest cl-keys)
+  "Return ITEM consed onto the front of LIST only if it's not already there.
+Otherwise, return LIST unmodified.
+\nKeywords supported:  :test :test-not :key
+\n(fn ITEM LIST [KEYWORD VALUE]...)"
+  (declare (compiler-macro cl--compiler-macro-adjoin))
+  (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 cl-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.
+\nKeywords supported:  :test :test-not :key
+\n(fn NEW OLD TREE [KEYWORD VALUE]...)"
+  (if (or cl-keys (and (numberp cl-old) (not (integerp cl-old))))
+      (apply 'cl-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 cl-acons (key value alist)
+  "Add KEY and VALUE to ALIST.
+Return a new list with (cons KEY VALUE) as car and ALIST as cdr."
+  (cons (cons key value) alist))
+
+(defun cl-pairlis (keys values &optional alist)
+  "Make an alist from KEYS and VALUES.
+Return a new alist composed by associating KEYS to corresponding VALUES;
+the process stops as soon as KEYS or VALUES run out.
+If ALIST is non-nil, the new pairs are prepended to it."
+  (nconc (cl-mapcar 'cons keys values) alist))
+
+
+;;; Generalized variables.
+
+;; These used to be in cl-macs.el since all macros that use them (like setf)
+;; were autoloaded from cl-macs.el.  But now that setf, push, and pop are in
+;; core Elisp, they need to either be right here or be autoloaded via
+;; cl-loaddefs.el, which is more trouble than it is worth.
+
+;; Some more Emacs-related place types.
+(gv-define-simple-setter buffer-file-name set-visited-file-name t)
+(gv-define-setter buffer-modified-p (flag &optional buf)
+  `(with-current-buffer ,buf
+     (set-buffer-modified-p ,flag)))
+(gv-define-simple-setter buffer-name rename-buffer t)
+(gv-define-setter buffer-string (store)
+  `(insert (prog1 ,store (erase-buffer))))
+(gv-define-simple-setter buffer-substring cl--set-buffer-substring)
+(gv-define-simple-setter current-buffer set-buffer)
+(gv-define-simple-setter current-case-table set-case-table)
+(gv-define-simple-setter current-column move-to-column t)
+(gv-define-simple-setter current-global-map use-global-map t)
+(gv-define-setter current-input-mode (store)
+  `(progn (apply #'set-input-mode ,store) ,store))
+(gv-define-simple-setter current-local-map use-local-map t)
+(gv-define-simple-setter current-window-configuration
+                         set-window-configuration t)
+(gv-define-simple-setter default-file-modes set-default-file-modes t)
+(gv-define-simple-setter documentation-property put)
+(gv-define-setter face-background (x f &optional s)
+  `(set-face-background ,f ,x ,s))
+(gv-define-setter face-background-pixmap (x f &optional s)
+  `(set-face-background-pixmap ,f ,x ,s))
+(gv-define-setter face-font (x f &optional s) `(set-face-font ,f ,x ,s))
+(gv-define-setter face-foreground (x f &optional s)
+  `(set-face-foreground ,f ,x ,s))
+(gv-define-setter face-underline-p (x f &optional s)
+  `(set-face-underline ,f ,x ,s))
+(gv-define-simple-setter file-modes set-file-modes t)
+(gv-define-simple-setter frame-height set-screen-height t)
+(gv-define-simple-setter frame-parameters modify-frame-parameters t)
+(gv-define-simple-setter frame-visible-p cl--set-frame-visible-p)
+(gv-define-simple-setter frame-width set-screen-width t)
+(gv-define-simple-setter getenv setenv t)
+(gv-define-simple-setter get-register set-register)
+(gv-define-simple-setter global-key-binding global-set-key)
+(gv-define-simple-setter local-key-binding local-set-key)
+(gv-define-simple-setter mark set-mark t)
+(gv-define-simple-setter mark-marker set-mark t)
+(gv-define-simple-setter marker-position set-marker t)
+(gv-define-setter mouse-position (store scr)
+  `(set-mouse-position ,scr (car ,store) (cadr ,store)
+                       (cddr ,store)))
+(gv-define-simple-setter point goto-char)
+(gv-define-simple-setter point-marker goto-char t)
+(gv-define-setter point-max (store)
+  `(progn (narrow-to-region (point-min) ,store) ,store))
+(gv-define-setter point-min (store)
+  `(progn (narrow-to-region ,store (point-max)) ,store))
+(gv-define-setter read-mouse-position (store scr)
+  `(set-mouse-position ,scr (car ,store) (cdr ,store)))
+(gv-define-simple-setter screen-height set-screen-height t)
+(gv-define-simple-setter screen-width set-screen-width t)
+(gv-define-simple-setter selected-window select-window)
+(gv-define-simple-setter selected-screen select-screen)
+(gv-define-simple-setter selected-frame select-frame)
+(gv-define-simple-setter standard-case-table set-standard-case-table)
+(gv-define-simple-setter syntax-table set-syntax-table)
+(gv-define-simple-setter visited-file-modtime set-visited-file-modtime t)
+(gv-define-setter window-height (store)
+  `(progn (enlarge-window (- ,store (window-height))) ,store))
+(gv-define-setter window-width (store)
+  `(progn (enlarge-window (- ,store (window-width)) t) ,store))
+(gv-define-simple-setter x-get-secondary-selection x-own-secondary-selection t)
+(gv-define-simple-setter x-get-selection x-own-selection t)
+
+;; More complex setf-methods.
+
+;; This is a hack that allows (setf (eq a 7) B) to mean either
+;; (setq a 7) or (setq a nil) depending on whether B is nil or not.
+;; This is useful when you have control over the PLACE but not over
+;; the VALUE, as is the case in define-minor-mode's :variable.
+;; It turned out that :variable needed more flexibility anyway, so
+;; this doesn't seem too useful now.
+(gv-define-expander eq
+  (lambda (do place val)
+    (gv-letplace (getter setter) place
+      (macroexp-let2 nil val val
+        (funcall do `(eq ,getter ,val)
+                 (lambda (v)
+                   `(cond
+                     (,v ,(funcall setter val))
+                     ((eq ,getter ,val) ,(funcall setter `(not ,val))))))))))
+
+(gv-define-expander substring
+  (lambda (do place from &optional to)
+    (gv-letplace (getter setter) place
+      (macroexp-let2 nil start from
+        (macroexp-let2 nil end to
+          (funcall do `(substring ,getter ,start ,end)
+                   (lambda (v)
+                     (funcall setter `(cl--set-substring
+                                       ,getter ,start ,end ,v)))))))))
+
+;;; Miscellaneous.
+
+;;;###autoload
+(progn
+  ;; Make sure functions defined with cl-defsubst can be inlined even in
+  ;; packages which do not require CL.  We don't put an autoload cookie
+  ;; directly on that function, since those cookies only go to cl-loaddefs.
+  (autoload 'cl--defsubst-expand "cl-macs")
+  ;; Autoload, so autoload.el and font-lock can use it even when CL
+  ;; is not loaded.
+  (put 'cl-defun    'doc-string-elt 3)
+  (put 'cl-defmacro 'doc-string-elt 3)
+  (put 'cl-defsubst 'doc-string-elt 3)
+  (put 'cl-defstruct 'doc-string-elt 2))
+
+(load "cl-loaddefs" nil 'quiet)
+
+(provide 'cl-lib)
+
+(run-hooks 'cl-load-hook)
+
+;; Local variables:
+;; byte-compile-dynamic: t
+;; End:
+
+;;; cl-lib.el ends here
diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el
index 1cd953d9e18..69882e36f22 100644
--- a/lisp/emacs-lisp/cl-loaddefs.el
+++ b/lisp/emacs-lisp/cl-loaddefs.el
@@ -3,23 +3,24 @@
 ;;; Code:
 
 
-;;;### (autoloads (cl-prettyexpand cl-macroexpand-all cl-remprop
-;;;;;;  cl-do-remf cl-set-getf getf get* tailp list-length nreconc
-;;;;;;  revappend concatenate subseq cl-float-limits random-state-p
-;;;;;;  make-random-state random* signum rem* mod* round* truncate*
-;;;;;;  ceiling* floor* isqrt lcm gcd cl-progv-before cl-set-frame-visible-p
-;;;;;;  cl-map-overlays cl-map-intervals cl-map-keymap-recursively
-;;;;;;  notevery notany every some mapcon mapcan mapl maplist map
-;;;;;;  cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "15a5e127e1c9c9c3d1f398963b66cde7")
+;;;### (autoloads (cl-prettyexpand cl-remprop cl--do-remf cl--set-getf
+;;;;;;  cl-getf cl-get cl-tailp cl-list-length cl-nreconc cl-revappend
+;;;;;;  cl-concatenate cl-subseq cl-float-limits cl-random-state-p
+;;;;;;  cl-make-random-state cl-random cl-signum cl-rem cl-mod cl-round
+;;;;;;  cl-truncate cl-ceiling cl-floor cl-isqrt cl-lcm cl-gcd cl--set-frame-visible-p
+;;;;;;  cl--map-overlays cl--map-intervals cl--map-keymap-recursively
+;;;;;;  cl-notevery cl-notany cl-every cl-some cl-mapcon cl-mapcan
+;;;;;;  cl-mapl cl-mapc cl-maplist cl-map cl--mapcar-many cl-equalp
+;;;;;;  cl-coerce) "cl-extra" "cl-extra.el" "8e9fee941c465ac0fee9b92a92d64154")
 ;;; Generated autoloads from cl-extra.el
 
-(autoload 'coerce "cl-extra" "\
+(autoload 'cl-coerce "cl-extra" "\
 Coerce OBJECT to type TYPE.
 TYPE is a Common Lisp type specifier.
 
 \(fn OBJECT TYPE)" nil nil)
 
-(autoload 'equalp "cl-extra" "\
+(autoload 'cl-equalp "cl-extra" "\
 Return 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
@@ -27,216 +28,216 @@ strings case-insensitively.
 
 \(fn X Y)" nil nil)
 
-(autoload 'cl-mapcar-many "cl-extra" "\
+(autoload 'cl--mapcar-many "cl-extra" "\
 
 
 \(fn CL-FUNC CL-SEQS)" nil nil)
 
-(autoload 'map "cl-extra" "\
+(autoload 'cl-map "cl-extra" "\
 Map a FUNCTION across one or more SEQUENCEs, returning a sequence.
 TYPE is the sequence type to return.
 
 \(fn TYPE FUNCTION SEQUENCE...)" nil nil)
 
-(autoload 'maplist "cl-extra" "\
+(autoload 'cl-maplist "cl-extra" "\
 Map FUNCTION to each sublist of LIST or LISTs.
-Like `mapcar', except applies to lists and their cdr's rather than to
+Like `cl-mapcar', except applies to lists and their cdr's rather than to
 the elements themselves.
 
 \(fn FUNCTION LIST...)" nil nil)
 
-(autoload 'mapl "cl-extra" "\
-Like `maplist', but does not accumulate values returned by the function.
+(autoload 'cl-mapc "cl-extra" "\
+Like `cl-mapcar', but does not accumulate values returned by the function.
+
+\(fn FUNCTION SEQUENCE...)" nil nil)
+
+(autoload 'cl-mapl "cl-extra" "\
+Like `cl-maplist', but does not accumulate values returned by the function.
 
 \(fn FUNCTION LIST...)" nil nil)
 
-(autoload 'mapcan "cl-extra" "\
-Like `mapcar', but nconc's together the values returned by the function.
+(autoload 'cl-mapcan "cl-extra" "\
+Like `cl-mapcar', but nconc's together the values returned by the function.
 
 \(fn FUNCTION SEQUENCE...)" nil nil)
 
-(autoload 'mapcon "cl-extra" "\
-Like `maplist', but nconc's together the values returned by the function.
+(autoload 'cl-mapcon "cl-extra" "\
+Like `cl-maplist', but nconc's together the values returned by the function.
 
 \(fn FUNCTION LIST...)" nil nil)
 
-(autoload 'some "cl-extra" "\
+(autoload 'cl-some "cl-extra" "\
 Return true if PREDICATE is true of any element of SEQ or SEQs.
 If so, return the true (non-nil) value returned by PREDICATE.
 
 \(fn PREDICATE SEQ...)" nil nil)
 
-(autoload 'every "cl-extra" "\
+(autoload 'cl-every "cl-extra" "\
 Return true if PREDICATE is true of every element of SEQ or SEQs.
 
 \(fn PREDICATE SEQ...)" nil nil)
 
-(autoload 'notany "cl-extra" "\
+(autoload 'cl-notany "cl-extra" "\
 Return true if PREDICATE is false of every element of SEQ or SEQs.
 
 \(fn PREDICATE SEQ...)" nil nil)
 
-(autoload 'notevery "cl-extra" "\
+(autoload 'cl-notevery "cl-extra" "\
 Return true if PREDICATE is false of some element of SEQ or SEQs.
 
 \(fn PREDICATE SEQ...)" nil nil)
 
-(defalias 'cl-map-keymap 'map-keymap)
-
-(autoload 'cl-map-keymap-recursively "cl-extra" "\
+(autoload 'cl--map-keymap-recursively "cl-extra" "\
 
 
 \(fn CL-FUNC-REC CL-MAP &optional CL-BASE)" nil nil)
 
-(autoload 'cl-map-intervals "cl-extra" "\
+(autoload 'cl--map-intervals "cl-extra" "\
 
 
 \(fn CL-FUNC &optional CL-WHAT CL-PROP CL-START CL-END)" nil nil)
 
-(autoload 'cl-map-overlays "cl-extra" "\
+(autoload 'cl--map-overlays "cl-extra" "\
 
 
 \(fn CL-FUNC &optional CL-BUFFER CL-START CL-END CL-ARG)" nil nil)
 
-(autoload 'cl-set-frame-visible-p "cl-extra" "\
+(autoload 'cl--set-frame-visible-p "cl-extra" "\
 
 
 \(fn FRAME VAL)" nil nil)
 
-(autoload 'cl-progv-before "cl-extra" "\
-
-
-\(fn SYMS VALUES)" nil nil)
-
-(autoload 'gcd "cl-extra" "\
+(autoload 'cl-gcd "cl-extra" "\
 Return the greatest common divisor of the arguments.
 
 \(fn &rest ARGS)" nil nil)
 
-(autoload 'lcm "cl-extra" "\
+(autoload 'cl-lcm "cl-extra" "\
 Return the least common multiple of the arguments.
 
 \(fn &rest ARGS)" nil nil)
 
-(autoload 'isqrt "cl-extra" "\
+(autoload 'cl-isqrt "cl-extra" "\
 Return the integer square root of the argument.
 
 \(fn X)" nil nil)
 
-(autoload 'floor* "cl-extra" "\
+(autoload 'cl-floor "cl-extra" "\
 Return a list of the floor of X and the fractional part of X.
 With two arguments, return floor and remainder of their quotient.
 
 \(fn X &optional Y)" nil nil)
 
-(autoload 'ceiling* "cl-extra" "\
+(autoload 'cl-ceiling "cl-extra" "\
 Return a list of the ceiling of X and the fractional part of X.
 With two arguments, return ceiling and remainder of their quotient.
 
 \(fn X &optional Y)" nil nil)
 
-(autoload 'truncate* "cl-extra" "\
+(autoload 'cl-truncate "cl-extra" "\
 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.
 
 \(fn X &optional Y)" nil nil)
 
-(autoload 'round* "cl-extra" "\
+(autoload 'cl-round "cl-extra" "\
 Return a list of X rounded to the nearest integer and the remainder.
 With two arguments, return rounding and remainder of their quotient.
 
 \(fn X &optional Y)" nil nil)
 
-(autoload 'mod* "cl-extra" "\
+(autoload 'cl-mod "cl-extra" "\
 The remainder of X divided by Y, with the same sign as Y.
 
 \(fn X Y)" nil nil)
 
-(autoload 'rem* "cl-extra" "\
+(autoload 'cl-rem "cl-extra" "\
 The remainder of X divided by Y, with the same sign as X.
 
 \(fn X Y)" nil nil)
 
-(autoload 'signum "cl-extra" "\
+(autoload 'cl-signum "cl-extra" "\
 Return 1 if X is positive, -1 if negative, 0 if zero.
 
 \(fn X)" nil nil)
 
-(autoload 'random* "cl-extra" "\
+(autoload 'cl-random "cl-extra" "\
 Return a random nonnegative number less than LIM, an integer or float.
 Optional second arg STATE is a random-state object.
 
 \(fn LIM &optional STATE)" nil nil)
 
-(autoload 'make-random-state "cl-extra" "\
-Return a copy of random-state STATE, or of `*random-state*' if omitted.
+(autoload 'cl-make-random-state "cl-extra" "\
+Return a copy of random-state STATE, or of the internal state if omitted.
 If STATE is t, return a new state object seeded from the time of day.
 
 \(fn &optional STATE)" nil nil)
 
-(autoload 'random-state-p "cl-extra" "\
+(autoload 'cl-random-state-p "cl-extra" "\
 Return t if OBJECT is a random-state object.
 
 \(fn OBJECT)" nil nil)
 
 (autoload 'cl-float-limits "cl-extra" "\
 Initialize the Common Lisp floating-point parameters.
-This sets the values of: `most-positive-float', `most-negative-float',
-`least-positive-float', `least-negative-float', `float-epsilon',
-`float-negative-epsilon', `least-positive-normalized-float', and
-`least-negative-normalized-float'.
+This sets the values of: `cl-most-positive-float', `cl-most-negative-float',
+`cl-least-positive-float', `cl-least-negative-float', `cl-float-epsilon',
+`cl-float-negative-epsilon', `cl-least-positive-normalized-float', and
+`cl-least-negative-normalized-float'.
 
 \(fn)" nil nil)
 
-(autoload 'subseq "cl-extra" "\
+(autoload 'cl-subseq "cl-extra" "\
 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.
 
 \(fn SEQ START &optional END)" nil nil)
 
-(autoload 'concatenate "cl-extra" "\
+(autoload 'cl-concatenate "cl-extra" "\
 Concatenate, into a sequence of type TYPE, the argument SEQUENCEs.
 
 \(fn TYPE SEQUENCE...)" nil nil)
 
-(autoload 'revappend "cl-extra" "\
+(autoload 'cl-revappend "cl-extra" "\
 Equivalent to (append (reverse X) Y).
 
 \(fn X Y)" nil nil)
 
-(autoload 'nreconc "cl-extra" "\
+(autoload 'cl-nreconc "cl-extra" "\
 Equivalent to (nconc (nreverse X) Y).
 
 \(fn X Y)" nil nil)
 
-(autoload 'list-length "cl-extra" "\
+(autoload 'cl-list-length "cl-extra" "\
 Return the length of list X.  Return nil if list is circular.
 
 \(fn X)" nil nil)
 
-(autoload 'tailp "cl-extra" "\
+(autoload 'cl-tailp "cl-extra" "\
 Return true if SUBLIST is a tail of LIST.
 
 \(fn SUBLIST LIST)" nil nil)
 
-(autoload 'get* "cl-extra" "\
+(autoload 'cl-get "cl-extra" "\
 Return the value of SYMBOL's PROPNAME property, or DEFAULT if none.
 
 \(fn SYMBOL PROPNAME &optional DEFAULT)" nil nil)
 
-(autoload 'getf "cl-extra" "\
+(put 'cl-get 'compiler-macro #'cl--compiler-macro-get)
+
+(autoload 'cl-getf "cl-extra" "\
 Search PROPLIST for property PROPNAME; return its value or DEFAULT.
 PROPLIST is a list of the sort returned by `symbol-plist'.
 
 \(fn PROPLIST PROPNAME &optional DEFAULT)" nil nil)
 
-(autoload 'cl-set-getf "cl-extra" "\
+(autoload 'cl--set-getf "cl-extra" "\
 
 
 \(fn PLIST TAG VAL)" nil nil)
 
-(autoload 'cl-do-remf "cl-extra" "\
+(autoload 'cl--do-remf "cl-extra" "\
 
 
 \(fn PLIST TAG)" nil nil)
@@ -246,136 +247,146 @@ Remove from SYMBOL's plist the property PROPNAME and its value.
 
 \(fn SYMBOL PROPNAME)" nil nil)
 
-(defalias 'remprop 'cl-remprop)
-
-(defalias 'cl-gethash 'gethash)
-
-(defalias 'cl-puthash 'puthash)
-
-(defalias 'cl-remhash 'remhash)
-
-(defalias 'cl-clrhash 'clrhash)
-
-(defalias 'cl-maphash 'maphash)
+(autoload 'cl-prettyexpand "cl-extra" "\
+Expand macros in FORM and insert the pretty-printed result.
+Optional argument FULL non-nil means to expand all macros,
+including `cl-block' and `cl-eval-when'.
 
-(defalias 'cl-make-hash-table 'make-hash-table)
+\(fn FORM &optional FULL)" nil nil)
 
-(defalias 'cl-hash-table-p 'hash-table-p)
+;;;***
+
+;;;### (autoloads (cl--compiler-macro-adjoin cl-defsubst cl-compiler-macroexpand
+;;;;;;  cl-define-compiler-macro cl-assert cl-check-type cl-typep
+;;;;;;  cl-deftype cl-defstruct cl-callf2 cl-callf cl-letf* cl-letf
+;;;;;;  cl-rotatef cl-shiftf cl-remf cl-psetf cl-declare cl-the cl-locally
+;;;;;;  cl-multiple-value-setq cl-multiple-value-bind cl-symbol-macrolet
+;;;;;;  cl-macrolet cl-labels cl-flet* cl-flet cl-progv cl-psetq
+;;;;;;  cl-do-all-symbols cl-do-symbols cl-dotimes cl-dolist cl-do*
+;;;;;;  cl-do cl-loop cl-return-from cl-return cl-block cl-etypecase
+;;;;;;  cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when
+;;;;;;  cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp
+;;;;;;  cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*)
+;;;;;;  "cl-macs" "cl-macs.el" "a7d9b56ea588b869813de8ed7ec1fbcd")
+;;; Generated autoloads from cl-macs.el
 
-(defalias 'cl-hash-table-count 'hash-table-count)
+(autoload 'cl--compiler-macro-list* "cl-macs" "\
 
-(autoload 'cl-macroexpand-all "cl-extra" "\
-Expand all macro calls through a Lisp FORM.
-This also does some trivial optimizations to make the form prettier.
 
-\(fn FORM &optional ENV)" nil nil)
+\(fn FORM ARG &rest OTHERS)" nil nil)
 
-(autoload 'cl-prettyexpand "cl-extra" "\
+(autoload 'cl--compiler-macro-cXXr "cl-macs" "\
 
 
-\(fn FORM &optional FULL)" nil nil)
+\(fn FORM X)" nil nil)
 
-;;;***
-
-;;;### (autoloads (defsubst* compiler-macroexpand define-compiler-macro
-;;;;;;  assert check-type typep deftype cl-struct-setf-expander defstruct
-;;;;;;  define-modify-macro callf2 callf letf* letf rotatef shiftf
-;;;;;;  remf cl-do-pop psetf setf get-setf-method defsetf define-setf-method
-;;;;;;  declare the locally multiple-value-setq multiple-value-bind
-;;;;;;  lexical-let* lexical-let symbol-macrolet macrolet labels
-;;;;;;  flet progv psetq do-all-symbols do-symbols dotimes dolist
-;;;;;;  do* do loop return-from return block etypecase typecase ecase
-;;;;;;  case load-time-value eval-when destructuring-bind function*
-;;;;;;  defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "cc8cbd8c86e2facbe61986e992e6c508")
-;;; Generated autoloads from cl-macs.el
-
-(autoload 'gensym "cl-macs" "\
+(autoload 'cl-gensym "cl-macs" "\
 Generate a new uninterned symbol.
 The name is made by appending a number to PREFIX, default \"G\".
 
 \(fn &optional PREFIX)" nil nil)
 
-(autoload 'gentemp "cl-macs" "\
+(autoload 'cl-gentemp "cl-macs" "\
 Generate a new interned symbol with a unique name.
 The name is made by appending a number to PREFIX, default \"G\".
 
 \(fn &optional PREFIX)" nil nil)
 
-(autoload 'defun* "cl-macs" "\
+(autoload 'cl-defun "cl-macs" "\
 Define NAME as a function.
 Like normal `defun', except ARGLIST allows full Common Lisp conventions,
-and BODY is implicitly surrounded by (block NAME ...).
+and BODY is implicitly surrounded by (cl-block NAME ...).
+
+\(fn NAME ARGLIST [DOCSTRING] BODY...)" nil t)
 
-\(fn NAME ARGLIST [DOCSTRING] BODY...)" nil (quote macro))
+(put 'cl-defun 'doc-string-elt '3)
 
-(autoload 'defmacro* "cl-macs" "\
+(put 'cl-defun 'lisp-indent-function '2)
+
+(autoload 'cl-defmacro "cl-macs" "\
 Define NAME as a macro.
 Like normal `defmacro', except ARGLIST allows full Common Lisp conventions,
-and BODY is implicitly surrounded by (block NAME ...).
+and BODY is implicitly surrounded by (cl-block NAME ...).
+
+\(fn NAME ARGLIST [DOCSTRING] BODY...)" nil t)
+
+(put 'cl-defmacro 'doc-string-elt '3)
 
-\(fn NAME ARGLIST [DOCSTRING] BODY...)" nil (quote macro))
+(put 'cl-defmacro 'lisp-indent-function '2)
 
-(autoload 'function* "cl-macs" "\
+(autoload 'cl-function "cl-macs" "\
 Introduce a function.
 Like normal `function', except that if argument is a lambda form,
 its argument list allows full Common Lisp conventions.
 
-\(fn FUNC)" nil (quote macro))
+\(fn FUNC)" nil t)
 
-(autoload 'destructuring-bind "cl-macs" "\
+(autoload 'cl-destructuring-bind "cl-macs" "\
+Bind the variables in ARGS to the result of EXPR and execute BODY.
 
+\(fn ARGS EXPR &rest BODY)" nil t)
 
-\(fn ARGS EXPR &rest BODY)" nil (quote macro))
+(put 'cl-destructuring-bind 'lisp-indent-function '2)
 
-(autoload 'eval-when "cl-macs" "\
+(autoload 'cl-eval-when "cl-macs" "\
 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.
 
-\(fn (WHEN...) BODY...)" nil (quote macro))
+\(fn (WHEN...) BODY...)" nil t)
 
-(autoload 'load-time-value "cl-macs" "\
+(put 'cl-eval-when 'lisp-indent-function '1)
+
+(autoload 'cl-load-time-value "cl-macs" "\
 Like `progn', but evaluates the body at load time.
 The result of the body appears to the compiler as a quoted constant.
 
-\(fn FORM &optional READ-ONLY)" nil (quote macro))
+\(fn FORM &optional READ-ONLY)" nil t)
 
-(autoload 'case "cl-macs" "\
+(autoload 'cl-case "cl-macs" "\
 Eval EXPR and choose among 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
+If no clause succeeds, cl-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'.
 
-\(fn EXPR (KEYLIST BODY...)...)" nil (quote macro))
+\(fn EXPR (KEYLIST BODY...)...)" nil t)
+
+(put 'cl-case 'lisp-indent-function '1)
 
-(autoload 'ecase "cl-macs" "\
-Like `case', but error if no case fits.
+(autoload 'cl-ecase "cl-macs" "\
+Like `cl-case', but error if no case fits.
 `otherwise'-clauses are not allowed.
 
-\(fn EXPR (KEYLIST BODY...)...)" nil (quote macro))
+\(fn EXPR (KEYLIST BODY...)...)" nil t)
+
+(put 'cl-ecase 'lisp-indent-function '1)
 
-(autoload 'typecase "cl-macs" "\
+(autoload 'cl-typecase "cl-macs" "\
 Evals EXPR, chooses among 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
+cl-typecase returns nil.  A TYPE of t or `otherwise' is allowed only in the
 final clause, and matches if no other keys match.
 
-\(fn EXPR (TYPE BODY...)...)" nil (quote macro))
+\(fn EXPR (TYPE BODY...)...)" nil t)
 
-(autoload 'etypecase "cl-macs" "\
-Like `typecase', but error if no case fits.
+(put 'cl-typecase 'lisp-indent-function '1)
+
+(autoload 'cl-etypecase "cl-macs" "\
+Like `cl-typecase', but error if no case fits.
 `otherwise'-clauses are not allowed.
 
-\(fn EXPR (TYPE BODY...)...)" nil (quote macro))
+\(fn EXPR (TYPE BODY...)...)" nil t)
+
+(put 'cl-etypecase 'lisp-indent-function '1)
 
-(autoload 'block "cl-macs" "\
+(autoload 'cl-block "cl-macs" "\
 Define a lexically-scoped block named NAME.
-NAME may be any symbol.  Code inside the BODY forms can call `return-from'
+NAME may be any symbol.  Code inside the BODY forms can call `cl-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
@@ -383,24 +394,28 @@ dynamically scoped:  Only references to it within BODY will work.  These
 references may appear inside macro expansions, but not inside functions
 called from BODY.
 
-\(fn NAME &rest BODY)" nil (quote macro))
+\(fn NAME &rest BODY)" nil t)
 
-(autoload 'return "cl-macs" "\
+(put 'cl-block 'lisp-indent-function '1)
+
+(autoload 'cl-return "cl-macs" "\
 Return from the block named nil.
-This is equivalent to `(return-from nil RESULT)'.
+This is equivalent to `(cl-return-from nil RESULT)'.
 
-\(fn &optional RESULT)" nil (quote macro))
+\(fn &optional RESULT)" nil t)
 
-(autoload 'return-from "cl-macs" "\
+(autoload 'cl-return-from "cl-macs" "\
 Return from the block named NAME.
-This jumps out to the innermost enclosing `(block NAME ...)' form,
+This jumps out to the innermost enclosing `(cl-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.
 
-\(fn NAME &optional RESULT)" nil (quote macro))
+\(fn NAME &optional RESULT)" nil t)
+
+(put 'cl-return-from 'lisp-indent-function '1)
 
-(autoload 'loop "cl-macs" "\
+(autoload 'cl-loop "cl-macs" "\
 The Common Lisp `loop' macro.
 Valid clauses are:
   for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM,
@@ -414,230 +429,194 @@ Valid clauses are:
   do EXPRS..., initially EXPRS..., finally EXPRS..., return EXPR,
   finally return EXPR, named NAME.
 
-\(fn CLAUSE...)" nil (quote macro))
+\(fn CLAUSE...)" nil t)
 
-(autoload 'do "cl-macs" "\
+(autoload 'cl-do "cl-macs" "\
 The Common Lisp `do' loop.
 
-\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil (quote macro))
+\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil t)
+
+(put 'cl-do 'lisp-indent-function '2)
 
-(autoload 'do* "cl-macs" "\
+(autoload 'cl-do* "cl-macs" "\
 The Common Lisp `do*' loop.
 
-\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil (quote macro))
+\(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil t)
 
-(autoload 'dolist "cl-macs" "\
+(put 'cl-do* 'lisp-indent-function '2)
+
+(autoload 'cl-dolist "cl-macs" "\
 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.
 An implicit nil block is established around the loop.
 
-\(fn (VAR LIST [RESULT]) BODY...)" nil (quote macro))
+\(fn (VAR LIST [RESULT]) BODY...)" nil t)
+
+(put 'cl-dolist 'lisp-indent-function '1)
 
-(autoload 'dotimes "cl-macs" "\
+(autoload 'cl-dotimes "cl-macs" "\
 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.
 
-\(fn (VAR COUNT [RESULT]) BODY...)" nil (quote macro))
+\(fn (VAR COUNT [RESULT]) BODY...)" nil t)
 
-(autoload 'do-symbols "cl-macs" "\
+(put 'cl-dotimes 'lisp-indent-function '1)
+
+(autoload 'cl-do-symbols "cl-macs" "\
 Loop over all symbols.
 Evaluate BODY with VAR bound to each interned symbol, or to each symbol
 from OBARRAY.
 
-\(fn (VAR [OBARRAY [RESULT]]) BODY...)" nil (quote macro))
+\(fn (VAR [OBARRAY [RESULT]]) BODY...)" nil t)
+
+(put 'cl-do-symbols 'lisp-indent-function '1)
 
-(autoload 'do-all-symbols "cl-macs" "\
+(autoload 'cl-do-all-symbols "cl-macs" "\
+Like `cl-do-symbols', but use the default obarray.
 
+\(fn (VAR [RESULT]) BODY...)" nil t)
 
-\(fn SPEC &rest BODY)" nil (quote macro))
+(put 'cl-do-all-symbols 'lisp-indent-function '1)
 
-(autoload 'psetq "cl-macs" "\
+(autoload 'cl-psetq "cl-macs" "\
 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.
 
-\(fn SYM VAL SYM VAL ...)" nil (quote macro))
+\(fn SYM VAL SYM VAL ...)" nil t)
 
-(autoload 'progv "cl-macs" "\
+(autoload 'cl-progv "cl-macs" "\
 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
+second list (or to nil 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.
 
-\(fn SYMBOLS VALUES &rest BODY)" nil (quote macro))
+\(fn SYMBOLS VALUES &rest BODY)" nil t)
+
+(put 'cl-progv 'lisp-indent-function '2)
+
+(autoload 'cl-flet "cl-macs" "\
+Make local function definitions.
+Like `cl-labels' but the definitions are not recursive.
+
+\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil t)
 
-(autoload 'flet "cl-macs" "\
-Make temporary function definitions.
-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).
+(put 'cl-flet 'lisp-indent-function '1)
 
-\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil (quote macro))
+(autoload 'cl-flet* "cl-macs" "\
+Make local function definitions.
+Like `cl-flet' but the definitions can refer to previous ones.
 
-(autoload 'labels "cl-macs" "\
+\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil t)
+
+(put 'cl-flet* 'lisp-indent-function '1)
+
+(autoload 'cl-labels "cl-macs" "\
 Make temporary function bindings.
-This is like `flet', except the bindings are lexical instead of dynamic.
-Unlike `flet', this macro is fully compliant with the Common Lisp standard.
+The bindings can be recursive and the scoping is lexical, but capturing them
+in closures will only work if `lexical-binding' is in use.
+
+\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil t)
 
-\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil (quote macro))
+(put 'cl-labels 'lisp-indent-function '1)
 
-(autoload 'macrolet "cl-macs" "\
+(autoload 'cl-macrolet "cl-macs" "\
 Make temporary macro definitions.
-This is like `flet', but for macros instead of functions.
+This is like `cl-flet', but for macros instead of functions.
 
-\(fn ((NAME ARGLIST BODY...) ...) FORM...)" nil (quote macro))
+\(fn ((NAME ARGLIST BODY...) ...) FORM...)" nil t)
 
-(autoload 'symbol-macrolet "cl-macs" "\
+(put 'cl-macrolet 'lisp-indent-function '1)
+
+(autoload 'cl-symbol-macrolet "cl-macs" "\
 Make symbol macro definitions.
 Within the body FORMs, references to the variable NAME will be replaced
 by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...).
 
-\(fn ((NAME EXPANSION) ...) FORM...)" nil (quote macro))
-
-(autoload 'lexical-let "cl-macs" "\
-Like `let', but lexically scoped.
-The main visible difference is that lambdas inside BODY will create
-lexical closures as in Common Lisp.
-
-\(fn BINDINGS BODY)" nil (quote macro))
+\(fn ((NAME EXPANSION) ...) FORM...)" nil t)
 
-(autoload 'lexical-let* "cl-macs" "\
-Like `let*', but lexically scoped.
-The main visible difference is that lambdas inside BODY, and in
-successive bindings within BINDINGS, will create lexical closures
-as in Common Lisp.  This is similar to the behavior of `let*' in
-Common Lisp.
+(put 'cl-symbol-macrolet 'lisp-indent-function '1)
 
-\(fn BINDINGS BODY)" nil (quote macro))
-
-(autoload 'multiple-value-bind "cl-macs" "\
+(autoload 'cl-multiple-value-bind "cl-macs" "\
 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
+is analogous to the Common Lisp `cl-multiple-value-bind' macro, using lists to
+simulate true multiple return values.  For compatibility, (cl-values A B C) is
 a synonym for (list A B C).
 
-\(fn (SYM...) FORM BODY)" nil (quote macro))
+\(fn (SYM...) FORM BODY)" nil t)
+
+(put 'cl-multiple-value-bind 'lisp-indent-function '2)
 
-(autoload 'multiple-value-setq "cl-macs" "\
+(autoload 'cl-multiple-value-setq "cl-macs" "\
 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).
+`cl-multiple-value-setq' macro, using lists to simulate true multiple return
+values.  For compatibility, (cl-values A B C) is a synonym for (list A B C).
 
-\(fn (SYM...) FORM)" nil (quote macro))
+\(fn (SYM...) FORM)" nil t)
 
-(autoload 'locally "cl-macs" "\
+(put 'cl-multiple-value-setq 'lisp-indent-function '1)
 
+(autoload 'cl-locally "cl-macs" "\
+Equivalent to `progn'.
 
-\(fn &rest BODY)" nil (quote macro))
+\(fn &rest BODY)" nil t)
 
-(autoload 'the "cl-macs" "\
+(autoload 'cl-the "cl-macs" "\
+At present this ignores _TYPE and is simply equivalent to FORM.
 
+\(fn TYPE FORM)" nil t)
 
-\(fn TYPE FORM)" nil (quote macro))
+(put 'cl-the 'lisp-indent-function '1)
 
-(autoload 'declare "cl-macs" "\
+(autoload 'cl-declare "cl-macs" "\
 Declare SPECS about the current function while compiling.
 For instance
 
-  (declare (warn 0))
+  (cl-declare (warn 0))
 
 will turn off byte-compile warnings in the function.
 See Info node `(cl)Declarations' for details.
 
-\(fn &rest SPECS)" nil (quote macro))
-
-(autoload 'define-setf-method "cl-macs" "\
-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.
-
-\(fn NAME ARGLIST BODY...)" nil (quote macro))
-
-(autoload 'defsetf "cl-macs" "\
-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:
+\(fn &rest SPECS)" nil t)
 
-  (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))
-
-\(fn NAME [FUNC | ARGLIST (STORE) BODY...])" nil (quote macro))
-
-(autoload 'get-setf-method "cl-macs" "\
-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'.
-
-\(fn PLACE &optional ENV)" nil nil)
-
-(autoload 'setf "cl-macs" "\
-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.
-
-\(fn PLACE VAL PLACE VAL ...)" nil (quote macro))
-
-(autoload 'psetf "cl-macs" "\
+(autoload 'cl-psetf "cl-macs" "\
 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.
 
-\(fn PLACE VAL PLACE VAL ...)" nil (quote macro))
-
-(autoload 'cl-do-pop "cl-macs" "\
-
+\(fn PLACE VAL PLACE VAL ...)" nil t)
 
-\(fn PLACE)" nil nil)
-
-(autoload 'remf "cl-macs" "\
+(autoload 'cl-remf "cl-macs" "\
 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.
 
-\(fn PLACE TAG)" nil (quote macro))
+\(fn PLACE TAG)" nil t)
 
-(autoload 'shiftf "cl-macs" "\
+(autoload 'cl-shiftf "cl-macs" "\
 Shift left among PLACEs.
-Example: (shiftf A B C) sets A to B, B to C, and returns the old A.
+Example: (cl-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'.
 
-\(fn PLACE... VAL)" nil (quote macro))
+\(fn PLACE... VAL)" nil t)
 
-(autoload 'rotatef "cl-macs" "\
+(autoload 'cl-rotatef "cl-macs" "\
 Rotate left among PLACEs.
-Example: (rotatef A B C) sets A to B, B to C, and C to A.  It returns nil.
+Example: (cl-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'.
 
-\(fn PLACE...)" nil (quote macro))
+\(fn PLACE...)" nil t)
 
-(autoload 'letf "cl-macs" "\
+(autoload 'cl-letf "cl-macs" "\
 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
@@ -647,41 +626,37 @@ 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.
 
-\(fn ((PLACE VALUE) ...) BODY...)" nil (quote macro))
+\(fn ((PLACE VALUE) ...) BODY...)" nil t)
+
+(put 'cl-letf 'lisp-indent-function '1)
 
-(autoload 'letf* "cl-macs" "\
+(autoload 'cl-letf* "cl-macs" "\
 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.
+Like `cl-letf' but where the bindings are performed one at a time,
+rather than all at the end (i.e. like `let*' rather than like `let').
+
+\(fn BINDINGS &rest BODY)" nil t)
 
-\(fn ((PLACE VALUE) ...) BODY...)" nil (quote macro))
+(put 'cl-letf* 'lisp-indent-function '1)
 
-(autoload 'callf "cl-macs" "\
+(autoload 'cl-callf "cl-macs" "\
 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'.
 
-\(fn FUNC PLACE ARGS...)" nil (quote macro))
+\(fn FUNC PLACE &rest ARGS)" nil t)
 
-(autoload 'callf2 "cl-macs" "\
-Set PLACE to (FUNC ARG1 PLACE ARGS...).
-Like `callf', but PLACE is the second argument of FUNC, not the first.
+(put 'cl-callf 'lisp-indent-function '2)
 
-\(fn FUNC ARG1 PLACE ARGS...)" nil (quote macro))
+(autoload 'cl-callf2 "cl-macs" "\
+Set PLACE to (FUNC ARG1 PLACE ARGS...).
+Like `cl-callf', but PLACE is the second argument of FUNC, not the first.
 
-(autoload 'define-modify-macro "cl-macs" "\
-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)) +)
+\(fn FUNC ARG1 PLACE ARGS...)" nil t)
 
-\(fn NAME ARGLIST FUNC &optional DOC)" nil (quote macro))
+(put 'cl-callf2 'lisp-indent-function '3)
 
-(autoload 'defstruct "cl-macs" "\
+(autoload 'cl-defstruct "cl-macs" "\
 Define a struct type.
 This macro defines a new data type called NAME that stores data
 in SLOTs.  It defines a `make-NAME' constructor, a `copy-NAME'
@@ -689,49 +664,51 @@ copier, a `NAME-p' predicate, and slot accessors named `NAME-SLOT'.
 You can use the accessors to set the corresponding slots, via `setf'.
 
 NAME may instead take the form (NAME OPTIONS...), where each
-OPTION is either a single keyword or (KEYWORD VALUE).
-See Info node `(cl)Structures' for a list of valid keywords.
+OPTION is either a single keyword or (KEYWORD VALUE) where
+KEYWORD can be one of :conc-name, :constructor, :copier, :predicate,
+:type, :named, :initial-offset, :print-function, or :include.
 
 Each SLOT may instead take the form (SLOT SLOT-OPTS...), where
 SLOT-OPTS are keyword-value pairs for that slot.  Currently, only
 one keyword is supported, `:read-only'.  If this has a non-nil
 value, that slot cannot be set via `setf'.
 
-\(fn NAME SLOTS...)" nil (quote macro))
+\(fn NAME SLOTS...)" nil t)
 
-(autoload 'cl-struct-setf-expander "cl-macs" "\
+(put 'cl-defstruct 'doc-string-elt '2)
 
+(put 'cl-defstruct 'lisp-indent-function '1)
 
-\(fn X NAME ACCESSOR PRED-FORM POS)" nil nil)
-
-(autoload 'deftype "cl-macs" "\
+(autoload 'cl-deftype "cl-macs" "\
 Define NAME as a new data type.
-The type name can then be used in `typecase', `check-type', etc.
+The type name can then be used in `cl-typecase', `cl-check-type', etc.
+
+\(fn NAME ARGLIST &rest BODY)" nil t)
 
-\(fn NAME ARGLIST &rest BODY)" nil (quote macro))
+(put 'cl-deftype 'doc-string-elt '3)
 
-(autoload 'typep "cl-macs" "\
+(autoload 'cl-typep "cl-macs" "\
 Check that OBJECT is of type TYPE.
 TYPE is a Common Lisp-style type specifier.
 
 \(fn OBJECT TYPE)" nil nil)
 
-(autoload 'check-type "cl-macs" "\
+(autoload 'cl-check-type "cl-macs" "\
 Verify that FORM is of type TYPE; signal an error if not.
 STRING is an optional description of the desired type.
 
-\(fn FORM TYPE &optional STRING)" nil (quote macro))
+\(fn FORM TYPE &optional STRING)" nil t)
 
-(autoload 'assert "cl-macs" "\
+(autoload 'cl-assert "cl-macs" "\
 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.
 
-\(fn FORM &optional SHOW-ARGS STRING &rest ARGS)" nil (quote macro))
+\(fn FORM &optional SHOW-ARGS STRING &rest ARGS)" nil t)
 
-(autoload 'define-compiler-macro "cl-macs" "\
+(autoload 'cl-define-compiler-macro "cl-macs" "\
 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
@@ -743,51 +720,63 @@ 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.
 
-\(fn FUNC ARGS &rest BODY)" nil (quote macro))
-
-(autoload 'compiler-macroexpand "cl-macs" "\
+\(fn FUNC ARGS &rest BODY)" nil t)
 
+(autoload 'cl-compiler-macroexpand "cl-macs" "\
+Like `macroexpand', but for compiler macros.
+Expands FORM repeatedly until no further expansion is possible.
+Returns FORM unchanged if it has no compiler macro, or if it has a
+macro that returns its `&whole' argument.
 
 \(fn FORM)" nil nil)
 
-(autoload 'defsubst* "cl-macs" "\
+(autoload 'cl-defsubst "cl-macs" "\
 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 ...).
+surrounded by (cl-block NAME ...).
+
+\(fn NAME ARGLIST [DOCSTRING] BODY...)" nil t)
+
+(put 'cl-defsubst 'lisp-indent-function '2)
 
-\(fn NAME ARGLIST [DOCSTRING] BODY...)" nil (quote macro))
+(autoload 'cl--compiler-macro-adjoin "cl-macs" "\
+
+
+\(fn FORM A LIST &rest KEYS)" nil nil)
 
 ;;;***
 
-;;;### (autoloads (tree-equal nsublis sublis nsubst-if-not nsubst-if
-;;;;;;  nsubst subst-if-not subst-if subsetp nset-exclusive-or set-exclusive-or
-;;;;;;  nset-difference set-difference nintersection intersection
-;;;;;;  nunion union rassoc-if-not rassoc-if rassoc* assoc-if-not
-;;;;;;  assoc-if assoc* cl-adjoin member-if-not member-if member*
-;;;;;;  merge stable-sort sort* search mismatch count-if-not count-if
-;;;;;;  count position-if-not position-if position find-if-not find-if
-;;;;;;  find nsubstitute-if-not nsubstitute-if nsubstitute substitute-if-not
-;;;;;;  substitute-if substitute delete-duplicates remove-duplicates
-;;;;;;  delete-if-not delete-if delete* remove-if-not remove-if remove*
-;;;;;;  replace fill reduce) "cl-seq" "cl-seq.el" "df375ddc313f0c1c262cacab5cffd3e4")
+;;;### (autoloads (cl-tree-equal cl-nsublis cl-sublis cl-nsubst-if-not
+;;;;;;  cl-nsubst-if cl-nsubst cl-subst-if-not cl-subst-if cl-subsetp
+;;;;;;  cl-nset-exclusive-or cl-set-exclusive-or cl-nset-difference
+;;;;;;  cl-set-difference cl-nintersection cl-intersection cl-nunion
+;;;;;;  cl-union cl-rassoc-if-not cl-rassoc-if cl-rassoc cl-assoc-if-not
+;;;;;;  cl-assoc-if cl-assoc cl--adjoin cl-member-if-not cl-member-if
+;;;;;;  cl-member cl-merge cl-stable-sort cl-sort cl-search cl-mismatch
+;;;;;;  cl-count-if-not cl-count-if cl-count cl-position-if-not cl-position-if
+;;;;;;  cl-position cl-find-if-not cl-find-if cl-find cl-nsubstitute-if-not
+;;;;;;  cl-nsubstitute-if cl-nsubstitute cl-substitute-if-not cl-substitute-if
+;;;;;;  cl-substitute cl-delete-duplicates cl-remove-duplicates cl-delete-if-not
+;;;;;;  cl-delete-if cl-delete cl-remove-if-not cl-remove-if cl-remove
+;;;;;;  cl-replace cl-fill cl-reduce) "cl-seq" "cl-seq.el" "4c1e1191e82dc8d5449a5ec4d59efc10")
 ;;; Generated autoloads from cl-seq.el
 
-(autoload 'reduce "cl-seq" "\
+(autoload 'cl-reduce "cl-seq" "\
 Reduce two-argument FUNCTION across SEQ.
 
 Keywords supported:  :start :end :from-end :initial-value :key
 
 \(fn FUNCTION SEQ [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'fill "cl-seq" "\
+(autoload 'cl-fill "cl-seq" "\
 Fill the elements of SEQ with ITEM.
 
 Keywords supported:  :start :end
 
 \(fn SEQ ITEM [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'replace "cl-seq" "\
+(autoload 'cl-replace "cl-seq" "\
 Replace the elements of SEQ1 with the elements of SEQ2.
 SEQ1 is destructively modified, then returned.
 
@@ -795,7 +784,7 @@ Keywords supported:  :start1 :end1 :start2 :end2
 
 \(fn SEQ1 SEQ2 [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'remove* "cl-seq" "\
+(autoload 'cl-remove "cl-seq" "\
 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.
@@ -804,7 +793,7 @@ Keywords supported:  :test :test-not :key :count :start :end :from-end
 
 \(fn ITEM SEQ [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'remove-if "cl-seq" "\
+(autoload 'cl-remove-if "cl-seq" "\
 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.
@@ -813,7 +802,7 @@ Keywords supported:  :key :count :start :end :from-end
 
 \(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'remove-if-not "cl-seq" "\
+(autoload 'cl-remove-if-not "cl-seq" "\
 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.
@@ -822,7 +811,7 @@ Keywords supported:  :key :count :start :end :from-end
 
 \(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'delete* "cl-seq" "\
+(autoload 'cl-delete "cl-seq" "\
 Remove all occurrences of ITEM in SEQ.
 This is a destructive function; it reuses the storage of SEQ whenever possible.
 
@@ -830,7 +819,7 @@ Keywords supported:  :test :test-not :key :count :start :end :from-end
 
 \(fn ITEM SEQ [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'delete-if "cl-seq" "\
+(autoload 'cl-delete-if "cl-seq" "\
 Remove all items satisfying PREDICATE in SEQ.
 This is a destructive function; it reuses the storage of SEQ whenever possible.
 
@@ -838,7 +827,7 @@ Keywords supported:  :key :count :start :end :from-end
 
 \(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'delete-if-not "cl-seq" "\
+(autoload 'cl-delete-if-not "cl-seq" "\
 Remove all items not satisfying PREDICATE in SEQ.
 This is a destructive function; it reuses the storage of SEQ whenever possible.
 
@@ -846,21 +835,21 @@ Keywords supported:  :key :count :start :end :from-end
 
 \(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'remove-duplicates "cl-seq" "\
+(autoload 'cl-remove-duplicates "cl-seq" "\
 Return a copy of SEQ with all duplicate elements removed.
 
 Keywords supported:  :test :test-not :key :start :end :from-end
 
 \(fn SEQ [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'delete-duplicates "cl-seq" "\
+(autoload 'cl-delete-duplicates "cl-seq" "\
 Remove all duplicate elements from SEQ (destructively).
 
 Keywords supported:  :test :test-not :key :start :end :from-end
 
 \(fn SEQ [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'substitute "cl-seq" "\
+(autoload 'cl-substitute "cl-seq" "\
 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.
@@ -869,7 +858,7 @@ Keywords supported:  :test :test-not :key :count :start :end :from-end
 
 \(fn NEW OLD SEQ [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'substitute-if "cl-seq" "\
+(autoload 'cl-substitute-if "cl-seq" "\
 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.
@@ -878,7 +867,7 @@ Keywords supported:  :key :count :start :end :from-end
 
 \(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'substitute-if-not "cl-seq" "\
+(autoload 'cl-substitute-if-not "cl-seq" "\
 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.
@@ -887,7 +876,7 @@ Keywords supported:  :key :count :start :end :from-end
 
 \(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'nsubstitute "cl-seq" "\
+(autoload 'cl-nsubstitute "cl-seq" "\
 Substitute NEW for OLD in SEQ.
 This is a destructive function; it reuses the storage of SEQ whenever possible.
 
@@ -895,7 +884,7 @@ Keywords supported:  :test :test-not :key :count :start :end :from-end
 
 \(fn NEW OLD SEQ [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'nsubstitute-if "cl-seq" "\
+(autoload 'cl-nsubstitute-if "cl-seq" "\
 Substitute NEW for all items satisfying PREDICATE in SEQ.
 This is a destructive function; it reuses the storage of SEQ whenever possible.
 
@@ -903,7 +892,7 @@ Keywords supported:  :key :count :start :end :from-end
 
 \(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'nsubstitute-if-not "cl-seq" "\
+(autoload 'cl-nsubstitute-if-not "cl-seq" "\
 Substitute NEW for all items not satisfying PREDICATE in SEQ.
 This is a destructive function; it reuses the storage of SEQ whenever possible.
 
@@ -911,7 +900,7 @@ Keywords supported:  :key :count :start :end :from-end
 
 \(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'find "cl-seq" "\
+(autoload 'cl-find "cl-seq" "\
 Find the first occurrence of ITEM in SEQ.
 Return the matching ITEM, or nil if not found.
 
@@ -919,7 +908,7 @@ Keywords supported:  :test :test-not :key :start :end :from-end
 
 \(fn ITEM SEQ [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'find-if "cl-seq" "\
+(autoload 'cl-find-if "cl-seq" "\
 Find the first item satisfying PREDICATE in SEQ.
 Return the matching item, or nil if not found.
 
@@ -927,7 +916,7 @@ Keywords supported:  :key :start :end :from-end
 
 \(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'find-if-not "cl-seq" "\
+(autoload 'cl-find-if-not "cl-seq" "\
 Find the first item not satisfying PREDICATE in SEQ.
 Return the matching item, or nil if not found.
 
@@ -935,7 +924,7 @@ Keywords supported:  :key :start :end :from-end
 
 \(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'position "cl-seq" "\
+(autoload 'cl-position "cl-seq" "\
 Find the first occurrence of ITEM in SEQ.
 Return the index of the matching item, or nil if not found.
 
@@ -943,7 +932,7 @@ Keywords supported:  :test :test-not :key :start :end :from-end
 
 \(fn ITEM SEQ [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'position-if "cl-seq" "\
+(autoload 'cl-position-if "cl-seq" "\
 Find the first item satisfying PREDICATE in SEQ.
 Return the index of the matching item, or nil if not found.
 
@@ -951,7 +940,7 @@ Keywords supported:  :key :start :end :from-end
 
 \(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'position-if-not "cl-seq" "\
+(autoload 'cl-position-if-not "cl-seq" "\
 Find the first item not satisfying PREDICATE in SEQ.
 Return the index of the matching item, or nil if not found.
 
@@ -959,28 +948,28 @@ Keywords supported:  :key :start :end :from-end
 
 \(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'count "cl-seq" "\
+(autoload 'cl-count "cl-seq" "\
 Count the number of occurrences of ITEM in SEQ.
 
 Keywords supported:  :test :test-not :key :start :end
 
 \(fn ITEM SEQ [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'count-if "cl-seq" "\
+(autoload 'cl-count-if "cl-seq" "\
 Count the number of items satisfying PREDICATE in SEQ.
 
 Keywords supported:  :key :start :end
 
 \(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'count-if-not "cl-seq" "\
+(autoload 'cl-count-if-not "cl-seq" "\
 Count the number of items not satisfying PREDICATE in SEQ.
 
 Keywords supported:  :key :start :end
 
 \(fn PREDICATE SEQ [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'mismatch "cl-seq" "\
+(autoload 'cl-mismatch "cl-seq" "\
 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 shorter sequence.
@@ -989,7 +978,7 @@ Keywords supported:  :test :test-not :key :start1 :end1 :start2 :end2 :from-end
 
 \(fn SEQ1 SEQ2 [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'search "cl-seq" "\
+(autoload 'cl-search "cl-seq" "\
 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.
@@ -998,7 +987,7 @@ Keywords supported:  :test :test-not :key :start1 :end1 :start2 :end2 :from-end
 
 \(fn SEQ1 SEQ2 [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'sort* "cl-seq" "\
+(autoload 'cl-sort "cl-seq" "\
 Sort the argument SEQ according to PREDICATE.
 This is a destructive function; it reuses the storage of SEQ if possible.
 
@@ -1006,7 +995,7 @@ Keywords supported:  :key
 
 \(fn SEQ PREDICATE [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'stable-sort "cl-seq" "\
+(autoload 'cl-stable-sort "cl-seq" "\
 Sort the argument SEQ stably according to PREDICATE.
 This is a destructive function; it reuses the storage of SEQ if possible.
 
@@ -1014,7 +1003,7 @@ Keywords supported:  :key
 
 \(fn SEQ PREDICATE [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'merge "cl-seq" "\
+(autoload 'cl-merge "cl-seq" "\
 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 PREDICATE is a `less-than' predicate on the elements.
@@ -1023,7 +1012,7 @@ Keywords supported:  :key
 
 \(fn TYPE SEQ1 SEQ2 PREDICATE [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'member* "cl-seq" "\
+(autoload 'cl-member "cl-seq" "\
 Find the first occurrence of ITEM in LIST.
 Return the sublist of LIST whose car is ITEM.
 
@@ -1031,7 +1020,9 @@ Keywords supported:  :test :test-not :key
 
 \(fn ITEM LIST [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'member-if "cl-seq" "\
+(put 'cl-member 'compiler-macro #'cl--compiler-macro-member)
+
+(autoload 'cl-member-if "cl-seq" "\
 Find the first item satisfying PREDICATE in LIST.
 Return the sublist of LIST whose car matches.
 
@@ -1039,7 +1030,7 @@ Keywords supported:  :key
 
 \(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'member-if-not "cl-seq" "\
+(autoload 'cl-member-if-not "cl-seq" "\
 Find the first item not satisfying PREDICATE in LIST.
 Return the sublist of LIST whose car matches.
 
@@ -1047,54 +1038,56 @@ Keywords supported:  :key
 
 \(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'cl-adjoin "cl-seq" "\
-Not documented
+(autoload 'cl--adjoin "cl-seq" "\
+
 
 \(fn CL-ITEM CL-LIST &rest CL-KEYS)" nil nil)
 
-(autoload 'assoc* "cl-seq" "\
+(autoload 'cl-assoc "cl-seq" "\
 Find the first item whose car matches ITEM in LIST.
 
 Keywords supported:  :test :test-not :key
 
 \(fn ITEM LIST [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'assoc-if "cl-seq" "\
+(put 'cl-assoc 'compiler-macro #'cl--compiler-macro-assoc)
+
+(autoload 'cl-assoc-if "cl-seq" "\
 Find the first item whose car satisfies PREDICATE in LIST.
 
 Keywords supported:  :key
 
 \(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'assoc-if-not "cl-seq" "\
+(autoload 'cl-assoc-if-not "cl-seq" "\
 Find the first item whose car does not satisfy PREDICATE in LIST.
 
 Keywords supported:  :key
 
 \(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'rassoc* "cl-seq" "\
+(autoload 'cl-rassoc "cl-seq" "\
 Find the first item whose cdr matches ITEM in LIST.
 
 Keywords supported:  :test :test-not :key
 
 \(fn ITEM LIST [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'rassoc-if "cl-seq" "\
+(autoload 'cl-rassoc-if "cl-seq" "\
 Find the first item whose cdr satisfies PREDICATE in LIST.
 
 Keywords supported:  :key
 
 \(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'rassoc-if-not "cl-seq" "\
+(autoload 'cl-rassoc-if-not "cl-seq" "\
 Find the first item whose cdr does not satisfy PREDICATE in LIST.
 
 Keywords supported:  :key
 
 \(fn PREDICATE LIST [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'union "cl-seq" "\
+(autoload 'cl-union "cl-seq" "\
 Combine LIST1 and LIST2 using a set-union operation.
 The resulting 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
@@ -1104,7 +1097,7 @@ Keywords supported:  :test :test-not :key
 
 \(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'nunion "cl-seq" "\
+(autoload 'cl-nunion "cl-seq" "\
 Combine LIST1 and LIST2 using a set-union operation.
 The resulting list contains all items that appear in either LIST1 or LIST2.
 This is a destructive function; it reuses the storage of LIST1 and LIST2
@@ -1114,7 +1107,7 @@ Keywords supported:  :test :test-not :key
 
 \(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'intersection "cl-seq" "\
+(autoload 'cl-intersection "cl-seq" "\
 Combine LIST1 and LIST2 using a set-intersection operation.
 The resulting 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
@@ -1124,7 +1117,7 @@ Keywords supported:  :test :test-not :key
 
 \(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'nintersection "cl-seq" "\
+(autoload 'cl-nintersection "cl-seq" "\
 Combine LIST1 and LIST2 using a set-intersection operation.
 The resulting list contains all items that appear in both LIST1 and LIST2.
 This is a destructive function; it reuses the storage of LIST1 and LIST2
@@ -1134,7 +1127,7 @@ Keywords supported:  :test :test-not :key
 
 \(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'set-difference "cl-seq" "\
+(autoload 'cl-set-difference "cl-seq" "\
 Combine LIST1 and LIST2 using a set-difference operation.
 The resulting 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
@@ -1144,7 +1137,7 @@ Keywords supported:  :test :test-not :key
 
 \(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'nset-difference "cl-seq" "\
+(autoload 'cl-nset-difference "cl-seq" "\
 Combine LIST1 and LIST2 using a set-difference operation.
 The resulting list contains all items that appear in LIST1 but not LIST2.
 This is a destructive function; it reuses the storage of LIST1 and LIST2
@@ -1154,7 +1147,7 @@ Keywords supported:  :test :test-not :key
 
 \(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'set-exclusive-or "cl-seq" "\
+(autoload 'cl-set-exclusive-or "cl-seq" "\
 Combine LIST1 and LIST2 using a set-exclusive-or operation.
 The resulting list contains all items appearing in exactly one of LIST1, LIST2.
 This is a non-destructive function; it makes a copy of the data if necessary
@@ -1164,7 +1157,7 @@ Keywords supported:  :test :test-not :key
 
 \(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'nset-exclusive-or "cl-seq" "\
+(autoload 'cl-nset-exclusive-or "cl-seq" "\
 Combine LIST1 and LIST2 using a set-exclusive-or operation.
 The resulting list contains all items appearing in exactly one of LIST1, LIST2.
 This is a destructive function; it reuses the storage of LIST1 and LIST2
@@ -1174,7 +1167,7 @@ Keywords supported:  :test :test-not :key
 
 \(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'subsetp "cl-seq" "\
+(autoload 'cl-subsetp "cl-seq" "\
 Return true if LIST1 is a subset of LIST2.
 I.e., if every element of LIST1 also appears in LIST2.
 
@@ -1182,7 +1175,7 @@ Keywords supported:  :test :test-not :key
 
 \(fn LIST1 LIST2 [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'subst-if "cl-seq" "\
+(autoload 'cl-subst-if "cl-seq" "\
 Substitute NEW for elements matching PREDICATE in TREE (non-destructively).
 Return a copy of TREE with all matching elements replaced by NEW.
 
@@ -1190,7 +1183,7 @@ Keywords supported:  :key
 
 \(fn NEW PREDICATE TREE [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'subst-if-not "cl-seq" "\
+(autoload 'cl-subst-if-not "cl-seq" "\
 Substitute NEW for elts not matching PREDICATE in TREE (non-destructively).
 Return a copy of TREE with all non-matching elements replaced by NEW.
 
@@ -1198,7 +1191,7 @@ Keywords supported:  :key
 
 \(fn NEW PREDICATE TREE [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'nsubst "cl-seq" "\
+(autoload 'cl-nsubst "cl-seq" "\
 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').
@@ -1207,7 +1200,7 @@ Keywords supported:  :test :test-not :key
 
 \(fn NEW OLD TREE [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'nsubst-if "cl-seq" "\
+(autoload 'cl-nsubst-if "cl-seq" "\
 Substitute NEW for elements matching PREDICATE in TREE (destructively).
 Any element of TREE which matches is changed to NEW (via a call to `setcar').
 
@@ -1215,7 +1208,7 @@ Keywords supported:  :key
 
 \(fn NEW PREDICATE TREE [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'nsubst-if-not "cl-seq" "\
+(autoload 'cl-nsubst-if-not "cl-seq" "\
 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').
 
@@ -1223,7 +1216,7 @@ Keywords supported:  :key
 
 \(fn NEW PREDICATE TREE [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'sublis "cl-seq" "\
+(autoload 'cl-sublis "cl-seq" "\
 Perform substitutions indicated by ALIST in TREE (non-destructively).
 Return a copy of TREE with all matching elements replaced.
 
@@ -1231,7 +1224,7 @@ Keywords supported:  :test :test-not :key
 
 \(fn ALIST TREE [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'nsublis "cl-seq" "\
+(autoload 'cl-nsublis "cl-seq" "\
 Perform substitutions indicated by ALIST in TREE (destructively).
 Any matching element of TREE is changed via a call to `setcar'.
 
@@ -1239,7 +1232,7 @@ Keywords supported:  :test :test-not :key
 
 \(fn ALIST TREE [KEYWORD VALUE]...)" nil nil)
 
-(autoload 'tree-equal "cl-seq" "\
+(autoload 'cl-tree-equal "cl-seq" "\
 Return t if trees TREE1 and TREE2 have `eql' leaves.
 Atoms are compared by `eql'; cons cells are compared recursively.
 
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index d9531cc5261..918e992512c 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -1,6 +1,6 @@
-;;; cl-macs.el --- Common Lisp macros
+;;; cl-macs.el --- Common Lisp macros  -*- lexical-binding: t; coding: utf-8 -*-
 
-;; Copyright (C) 1993, 2001-2011  Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001-2012  Free Software Foundation, Inc.
 
 ;; Author: Dave Gillespie <daveg@synaptics.com>
 ;; Version: 2.02
@@ -43,268 +43,215 @@
 
 ;;; Code:
 
-(require 'cl)
+(require 'cl-lib)
+(require 'macroexp)
+;; `gv' is required here because cl-macs can be loaded before loaddefs.el.
+(require 'gv)
 
 (defmacro cl-pop2 (place)
-  (list 'prog1 (list 'car (list 'cdr place))
-	(list 'setq place (list 'cdr (list 'cdr place)))))
-(put 'cl-pop2 'edebug-form-spec 'edebug-sexps)
+  (declare (debug edebug-sexps))
+  `(prog1 (car (cdr ,place))
+     (setq ,place (cdr (cdr ,place)))))
 
 (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 '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)
+;; Place compiler macros at the beginning, otherwise uses of the corresponding
+;; functions can lead to recursive-loads that prevent the calls from
+;; being optimized.
 
-;;; Some predicates for analyzing Lisp forms.  These are used by various
-;;; macro expanders to optimize the results in certain common cases.
+;;;###autoload
+(defun cl--compiler-macro-list* (_form arg &rest others)
+  (let* ((args (reverse (cons arg others)))
+	 (form (car args)))
+    (while (setq args (cdr args))
+      (setq form `(cons ,(car args) ,form)))
+    form))
 
-(defconst cl-simple-funcs '(car cdr nth aref elt if and or + - 1+ 1- min max
+;;;###autoload
+(defun cl--compiler-macro-cXXr (form x)
+  (let* ((head (car form))
+         (n (symbol-name (car form)))
+         (i (- (length n) 2)))
+    (if (not (string-match "c[ad]+r\\'" n))
+        (if (and (fboundp head) (symbolp (symbol-function head)))
+            (cl--compiler-macro-cXXr (cons (symbol-function head) (cdr form))
+                                     x)
+          (error "Compiler macro for cXXr applied to non-cXXr form"))
+      (while (> i (match-beginning 0))
+        (setq x (list (if (eq (aref n i) ?a) 'car 'cdr) x))
+        (setq i (1- i)))
+      x)))
+
+;;; 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
+(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)
+(defun cl--simple-expr-p (x &optional size)
+  "Check if no side effects, and executes quickly."
   (or size (setq size 10))
-  (if (and (consp x) (not (memq (car x) '(quote function function*))))
+  (if (and (consp x) (not (memq (car x) '(quote function cl-function))))
       (and (symbolp (car x))
-	   (or (memq (car x) cl-simple-funcs)
+	   (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))))
+			 (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)))
+(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*)))))
+(defun cl--safe-expr-p (x)
+  "Check if no side effects."
+  (or (not (and (consp x) (not (memq (car x) '(quote function cl-function)))))
       (and (symbolp (car x))
-	   (or (memq (car x) cl-simple-funcs)
-	       (memq (car x) cl-safe-funcs)
+	   (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))))
+	     (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)
+(defun cl--const-expr-p (x)
   (cond ((consp x)
 	 (or (eq (car x) 'quote)
-	     (and (memq (car x) '(function function*))
+	     (and (memq (car x) '(function cl-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)
-  ;; This apparently tries to return nil iff the expression X evaluates
-  ;; the variables V in the same order as they appear in V (so as to
-  ;; be able to replace those vars with the expressions they're bound
-  ;; to).
-  ;; FIXME: This is very naive, it doesn't even check to see if those
-  ;; variables appear more than once.
-  (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)))))
+(defun cl--const-expr-val (x)
+  (and (macroexp-const-p x) (if (consp x) (nth 1 x) x)))
 
-;;; Count number of times X refers to Y.  Return nil for 0 times.
-(defun cl-expr-contains (x y)
+(defun cl--expr-contains (x y)
+  "Count number of times X refers to Y.  Return nil for 0 times."
+  ;; FIXME: This is naive, and it will cl-count Y as referred twice in
+  ;; (let ((Y 1)) Y) even though it should be 0.  Also it is often called on
+  ;; non-macroexpanded code, so it may also miss some occurrences that would
+  ;; only appear in the expanded code.
   (cond ((equal y x) 1)
-	((and (consp x) (not (memq (car-safe x) '(quote function function*))))
+	((and (consp x) (not (memq (car x) '(quote function cl-function))))
 	 (let ((sum 0))
-	   (while x
-	     (setq sum (+ sum (or (cl-expr-contains (pop x) y) 0))))
+	   (while (consp x)
+	     (setq sum (+ sum (or (cl--expr-contains (pop x) y) 0))))
+	   (setq sum (+ sum (or (cl--expr-contains 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)))) (pop y))
+(defun cl--expr-contains-any (x y)
+  (while (and y (not (cl--expr-contains x (car y)))) (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))))
+(defun cl--expr-depends-p (x y)
+  "Check whether X may depend on any of the symbols in Y."
+  (and (not (macroexp-const-p x))
+       (or (not (cl--safe-expr-p x)) (cl--expr-contains-any x y))))
 
 ;;; Symbols.
 
-(defvar *gensym-counter*)
+(defvar cl--gensym-counter)
 ;;;###autoload
-(defun gensym (&optional prefix)
+(defun cl-gensym (&optional prefix)
   "Generate a new uninterned symbol.
 The name is made by appending a number to PREFIX, default \"G\"."
   (let ((pfix (if (stringp prefix) prefix "G"))
 	(num (if (integerp prefix) prefix
-	       (prog1 *gensym-counter*
-		 (setq *gensym-counter* (1+ *gensym-counter*))))))
+	       (prog1 cl--gensym-counter
+		 (setq cl--gensym-counter (1+ cl--gensym-counter))))))
     (make-symbol (format "%s%d" pfix num))))
 
 ;;;###autoload
-(defun gentemp (&optional prefix)
+(defun cl-gentemp (&optional prefix)
   "Generate a new interned symbol with a unique name.
 The name is made by appending a number to PREFIX, default \"G\"."
   (let ((pfix (if (stringp prefix) prefix "G"))
 	name)
-    (while (intern-soft (setq name (format "%s%d" pfix *gensym-counter*)))
-      (setq *gensym-counter* (1+ *gensym-counter*)))
+    (while (intern-soft (setq name (format "%s%d" pfix cl--gensym-counter)))
+      (setq cl--gensym-counter (1+ cl--gensym-counter)))
     (intern name)))
 
 
 ;;; Program structure.
 
-;;;###autoload
-(defmacro defun* (name args &rest body)
-  "Define NAME as a function.
-Like normal `defun', except ARGLIST allows full Common Lisp conventions,
-and BODY is implicitly surrounded by (block NAME ...).
+(def-edebug-spec cl-declarations
+  (&rest ("cl-declare" &rest sexp)))
 
-\(fn NAME ARGLIST [DOCSTRING] BODY...)"
-  (let* ((res (cl-transform-lambda (cons args body) name))
-	 (form (list* 'defun name (cdr res))))
-    (if (car res) (list 'progn (car res) form) form)))
+(def-edebug-spec cl-declarations-or-string
+  (&or stringp cl-declarations))
 
-;;;###autoload
-(defmacro defmacro* (name args &rest body)
-  "Define NAME as a macro.
-Like normal `defmacro', except ARGLIST allows full Common Lisp conventions,
-and BODY is implicitly surrounded by (block NAME ...).
+(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-keys"]]
+    [&optional ["&aux" &rest
+		&or (symbolp &optional def-form) symbolp]]
+    )))
 
-\(fn NAME ARGLIST [DOCSTRING] BODY...)"
-  (let* ((res (cl-transform-lambda (cons args body) name))
-	 (form (list* 'defmacro name (cdr res))))
-    (if (car res) (list 'progn (car res) form) form)))
+(def-edebug-spec cl-&optional-arg
+  (&or (arg &optional def-form arg) arg))
 
-;;;###autoload
-(defmacro function* (func)
-  "Introduce a function.
-Like normal `function', except that if argument is a lambda form,
-its argument list 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))
+(def-edebug-spec cl-&key-arg
+  (&or ([&or (symbolp arg) arg] &optional def-form arg) arg))
 
-(defvar cl-macro-environment nil
-  "Keep the list of currently active macros.
-It is a list of elements of the form either:
-- (SYMBOL . FUNCTION) where FUNCTION is the macro expansion function.
-- (SYMBOL-NAME . EXPANSION) where SYMBOL-NAME is the name of a symbol macro.")
-(defvar bind-block) (defvar bind-defs) (defvar bind-enquote)
-(defvar bind-inits) (defvar bind-lets) (defvar bind-forms)
+(defconst cl--lambda-list-keywords
+  '(&optional &rest &key &allow-other-keys &aux &whole &body &environment))
 
-(declare-function help-add-fundoc-usage "help-fns" (docstring arglist))
+(defvar cl--bind-block) (defvar cl--bind-defs) (defvar cl--bind-enquote)
+(defvar cl--bind-inits) (defvar cl--bind-lets) (defvar cl--bind-forms)
 
-(defun cl--make-usage-var (x)
-  "X can be a var or a (destructuring) lambda-list."
-  (cond
-   ((symbolp x) (make-symbol (upcase (symbol-name x))))
-   ((consp x) (cl--make-usage-args x))
-   (t x)))
-
-(defun cl--make-usage-args (arglist)
-  ;; `orig-args' can contain &cl-defs (an internal
-  ;; CL thingy I don't understand), so remove it.
-  (let ((x (memq '&cl-defs arglist)))
-    (when x (setq arglist (delq (car x) (remq (cadr x) arglist)))))
-  (let ((state nil))
-    (mapcar (lambda (x)
-              (cond
-               ((symbolp x)
-                (if (eq ?\& (aref (symbol-name x) 0))
-                    (setq state x)
-                  (make-symbol (upcase (symbol-name x)))))
-               ((not (consp x)) x)
-               ((memq state '(nil &rest)) (cl--make-usage-args x))
-               (t        ;(VAR INITFORM SVAR) or ((KEYWORD VAR) INITFORM SVAR).
-                (list*
-                 (if (and (consp (car x)) (eq state '&key))
-                     (list (caar x) (cl--make-usage-var (nth 1 (car x))))
-                   (cl--make-usage-var (car x)))
-                 (nth 1 x)                          ;INITFORM.
-                 (cl--make-usage-args (nthcdr 2 x)) ;SVAR.
-                 ))))
-            arglist)))
-
-(defun cl-transform-lambda (form bind-block)
+(defun cl--transform-lambda (form bind-block)
   (let* ((args (car form)) (body (cdr form)) (orig-args args)
-	 (bind-defs nil) (bind-enquote nil)
-	 (bind-inits nil) (bind-lets nil) (bind-forms nil)
+	 (cl--bind-block bind-block) (cl--bind-defs nil) (cl--bind-enquote nil)
+	 (cl--bind-inits nil) (cl--bind-lets nil) (cl--bind-forms nil)
 	 (header nil) (simple-args nil))
     (while (or (stringp (car body))
-	       (memq (car-safe (car body)) '(interactive declare)))
+	       (memq (car-safe (car body)) '(interactive cl-declare)))
       (push (pop body) header))
-    (setq args (if (listp args) (copy-list args) (list '&rest args)))
+    (setq args (if (listp args) (cl-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))
+    (if (setq cl--bind-defs (cadr (memq '&cl-defs args)))
+	(setq args (delq '&cl-defs (delq cl--bind-defs args))
+	      cl--bind-defs (cadr cl--bind-defs)))
+    (if (setq cl--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)))
+    (let* ((p (memq '&environment args)) (v (cadr p))
+           (env-exp 'macroexpand-all-environment))
       (if p (setq args (nconc (delq (car p) (delq v args))
-			      (list '&aux (list v 'cl-macro-environment))))))
+                              (list '&aux (list v env-exp))))))
     (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))))))
+			  (or cl--bind-defs (consp (cadr args))))))
       (push (pop args) simple-args))
-    (or (eq bind-block 'cl-none)
-	(setq body (list (list* 'block bind-block body))))
+    (or (eq cl--bind-block 'cl-none)
+	(setq body (list `(cl-block ,cl--bind-block ,@body))))
     (if (null args)
-	(list* nil (nreverse simple-args) (nconc (nreverse header) body))
+	(cl-list* nil (nreverse simple-args) (nconc (nreverse header) body))
       (if (memq '&optional simple-args) (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)))
+      (cl--do-arglist args nil (- (length simple-args)
+                                  (if (memq '&optional simple-args) 1 0)))
+      (setq cl--bind-lets (nreverse cl--bind-lets))
+      (cl-list* (and cl--bind-inits `(cl-eval-when (compile load eval)
+                                ,@(nreverse cl--bind-inits)))
 	     (nconc (nreverse simple-args)
-		    (list '&rest (car (pop bind-lets))))
+		    (list '&rest (car (pop cl--bind-lets))))
 	     (nconc (let ((hdr (nreverse header)))
                       ;; Macro expansion can take place in the middle of
                       ;; apparently harmless computation, so it should not
@@ -313,236 +260,385 @@ It is a list of elements of the form either:
                         (require 'help-fns)
                         (cons (help-add-fundoc-usage
                                (if (stringp (car hdr)) (pop hdr))
-                               (format "(fn %S)"
-                                       (cl--make-usage-args orig-args)))
+                               ;; Be careful with make-symbol and (back)quote,
+                               ;; see bug#12884.
+                               (let ((print-gensym nil) (print-quoted t))
+                                 (format "%S" (cons 'fn (cl--make-usage-args
+                                                         orig-args)))))
                               hdr)))
-		    (list (nconc (list 'let* bind-lets)
-				 (nreverse bind-forms) body)))))))
+		    (list `(let* ,cl--bind-lets
+                             ,@(nreverse cl--bind-forms)
+                             ,@body)))))))
+
+;;;###autoload
+(defmacro cl-defun (name args &rest body)
+  "Define NAME as a function.
+Like normal `defun', except ARGLIST allows full Common Lisp conventions,
+and BODY is implicitly surrounded by (cl-block NAME ...).
+
+\(fn NAME ARGLIST [DOCSTRING] BODY...)"
+  (declare (debug
+            ;; 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))
+           (doc-string 3)
+           (indent 2))
+  (let* ((res (cl--transform-lambda (cons args body) name))
+	 (form `(defun ,name ,@(cdr res))))
+    (if (car res) `(progn ,(car res) ,form) form)))
+
+;; 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-keys"]]
+    [&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-keys"]]
+    [&optional ["&aux" &rest
+		&or (symbolp &optional def-form) symbolp]]
+    . [&or arg nil])))
+
+;;;###autoload
+(defmacro cl-defmacro (name args &rest body)
+  "Define NAME as a macro.
+Like normal `defmacro', except ARGLIST allows full Common Lisp conventions,
+and BODY is implicitly surrounded by (cl-block NAME ...).
+
+\(fn NAME ARGLIST [DOCSTRING] BODY...)"
+  (declare (debug
+            (&define name cl-macro-list cl-declarations-or-string def-body))
+           (doc-string 3)
+           (indent 2))
+  (let* ((res (cl--transform-lambda (cons args body) name))
+	 (form `(defmacro ,name ,@(cdr res))))
+    (if (car res) `(progn ,(car res) ,form) form)))
+
+(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 cl-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)
+       ("cl-function" cl-function)
+       form))
+
+;;;###autoload
+(defmacro cl-function (func)
+  "Introduce a function.
+Like normal `function', except that if argument is a lambda form,
+its argument list allows full Common Lisp conventions."
+  (declare (debug (&or symbolp cl-lambda-expr)))
+  (if (eq (car-safe func) 'lambda)
+      (let* ((res (cl--transform-lambda (cdr func) 'cl-none))
+	     (form `(function (lambda . ,(cdr res)))))
+	(if (car res) `(progn ,(car res) ,form) form))
+    `(function ,func)))
+
+(declare-function help-add-fundoc-usage "help-fns" (docstring arglist))
+
+(defun cl--make-usage-var (x)
+  "X can be a var or a (destructuring) lambda-list."
+  (cond
+   ((symbolp x) (make-symbol (upcase (symbol-name x))))
+   ((consp x) (cl--make-usage-args x))
+   (t x)))
 
-(defun cl-do-arglist (args expr &optional num)   ; uses bind-*
+(defun cl--make-usage-args (arglist)
+  (if (cdr-safe (last arglist))         ;Not a proper list.
+      (let* ((last (last arglist))
+             (tail (cdr last)))
+        (unwind-protect
+            (progn
+              (setcdr last nil)
+              (nconc (cl--make-usage-args arglist) (cl--make-usage-var tail)))
+          (setcdr last tail)))
+    ;; `orig-args' can contain &cl-defs (an internal
+    ;; CL thingy I don't understand), so remove it.
+    (let ((x (memq '&cl-defs arglist)))
+      (when x (setq arglist (delq (car x) (remq (cadr x) arglist)))))
+    (let ((state nil))
+      (mapcar (lambda (x)
+                (cond
+                 ((symbolp x)
+                  (let ((first (aref (symbol-name x) 0)))
+                    (if (eq ?\& first)
+                        (setq state x)
+                      ;; Strip a leading underscore, since it only
+                      ;; means that this argument is unused.
+                      (make-symbol (upcase (if (eq ?_ first)
+                                               (substring (symbol-name x) 1)
+                                             (symbol-name x)))))))
+                 ((not (consp x)) x)
+                 ((memq state '(nil &rest)) (cl--make-usage-args x))
+                 (t      ;(VAR INITFORM SVAR) or ((KEYWORD VAR) INITFORM SVAR).
+                  (cl-list*
+                   (if (and (consp (car x)) (eq state '&key))
+                       (list (caar x) (cl--make-usage-var (nth 1 (car x))))
+                     (cl--make-usage-var (car x)))
+                   (nth 1 x)                        ;INITFORM.
+                   (cl--make-usage-args (nthcdr 2 x)) ;SVAR.
+                   ))))
+              arglist))))
+
+(defun cl--do-arglist (args expr &optional num)   ; uses bind-*
   (if (nlistp args)
-      (if (or (memq args lambda-list-keywords) (not (symbolp args)))
+      (if (or (memq args cl--lambda-list-keywords) (not (symbolp args)))
 	  (error "Invalid argument name: %s" args)
-	(push (list args expr) bind-lets))
-    (setq args (copy-list args))
+	(push (list args expr) cl--bind-lets))
+    (setq args (cl-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))
+	  (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 (make-symbol "--cl-rest--"))
 	(setq restarg (cadr restarg)))
-      (push (list restarg expr) bind-lets)
+      (push (list restarg expr) cl--bind-lets)
       (if (eq (car args) '&whole)
-	  (push (list (cl-pop2 args) restarg) bind-lets))
+	  (push (list (cl-pop2 args) restarg) cl--bind-lets))
       (let ((p args))
 	(setq minarg restarg)
-	(while (and p (not (memq (car p) lambda-list-keywords)))
+	(while (and p (not (memq (car p) cl--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)))
+	    (setq minarg `(= (length ,restarg)
+                             ,(length (cl-ldiff args p)))
 		  exactarg (not (eq args p)))))
-      (while (and args (not (memq (car args) lambda-list-keywords)))
+      (while (and args (not (memq (car args) cl--lambda-list-keywords)))
 	(let ((poparg (list (if (or (cdr args) (not exactarg)) 'pop 'car)
 			    restarg)))
-	  (cl-do-arglist
+	  (cl--do-arglist
 	   (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)))))))
+	     `(if ,minarg ,poparg
+                (signal 'wrong-number-of-arguments
+                        (list ,(and (not (eq cl--bind-block 'cl-none))
+                                    `',cl--bind-block)
+                              (length ,restarg)))))))
 	(setq num (1+ num) laterarg t))
       (while (and (eq (car args) '&optional) (pop args))
-	(while (and args (not (memq (car args) lambda-list-keywords)))
+	(while (and args (not (memq (car args) cl--lambda-list-keywords)))
 	  (let ((arg (pop args)))
 	    (or (consp arg) (setq arg (list arg)))
-	    (if (cddr arg) (cl-do-arglist (nth 2 arg) (list 'and restarg t)))
+	    (if (cddr arg) (cl--do-arglist (nth 2 arg) `(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))
+			 (or (car cl--bind-defs)
+			     (nth 1 (assq (car arg) cl--bind-defs)))))
+		  (poparg `(pop ,restarg)))
+	      (and def cl--bind-enquote (setq def `',def))
+	      (cl--do-arglist (car arg)
+			     (if def `(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)))
+	    (if (consp arg) (cl--do-arglist arg restarg)))
 	(or (eq (car args) '&key) (= safety 0) exactarg
-	    (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)))
+	    (push `(if ,restarg
+                       (signal 'wrong-number-of-arguments
+                               (list
+                                ,(and (not (eq cl--bind-block 'cl-none))
+                                      `',cl--bind-block)
+                                (+ ,num (length ,restarg)))))
+                  cl--bind-forms)))
       (while (and (eq (car args) '&key) (pop args))
-	(while (and args (not (memq (car args) lambda-list-keywords)))
+	(while (and args (not (memq (car args) cl--lambda-list-keywords)))
 	  (let ((arg (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)))
+                           (let ((name (symbol-name (car arg))))
+                             ;; Strip a leading underscore, since it only
+                             ;; means that this argument is unused, but
+                             ;; shouldn't affect the key's name (bug#12367).
+                             (if (eq ?_ (aref name 0))
+                                 (setq name (substring name 1)))
+                             (intern (format ":%s" name)))))
+		   (varg (if (consp (car arg)) (cl-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)))
+			  (or (car cl--bind-defs) (cadr (assq varg cl--bind-defs)))))
+		   (look `(memq ',karg ,restarg)))
+	      (and def cl--bind-enquote (setq def `',def))
 	      (if (cddr arg)
 		  (let* ((temp (or (nth 2 arg) (make-symbol "--cl-var--")))
-			 (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
+			 (val `(car (cdr ,temp))))
+		    (cl--do-arglist temp look)
+		    (cl--do-arglist varg
+				   `(if ,temp
+                                        (prog1 ,val (setq ,temp t))
+                                      ,def)))
+		(cl--do-arglist
 		 varg
-		 (list 'car
-		       (list 'cdr
-			     (if (null def)
+		 `(car (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))))))))
+			       `(or ,look
+                                    ,(if (eq (cl--const-expr-p def) t)
+					 `'(nil ,(cl--const-expr-val def))
+				       `(list nil ,def))))))))
 	      (push karg keys)))))
       (setq keys (nreverse keys))
       (or (and (eq (car args) '&allow-other-keys) (pop args))
 	  (null keys) (= safety 0)
 	  (let* ((var (make-symbol "--cl-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)))))))
-	    (push (list 'let (list (list var restarg)) check) bind-forms)))
+		 (check `(while ,var
+                           (cond
+                            ((memq (car ,var) ',(append keys allow))
+                             (setq ,var (cdr (cdr ,var))))
+                            ((car (cdr (memq (quote ,@allow) ,restarg)))
+                             (setq ,var nil))
+                            (t
+                             (error
+                              ,(format "Keyword argument %%s not one of %s"
+                                       keys)
+                              (car ,var)))))))
+	    (push `(let ((,var ,restarg)) ,check) cl--bind-forms)))
       (while (and (eq (car args) '&aux) (pop args))
-	(while (and args (not (memq (car args) lambda-list-keywords)))
+	(while (and args (not (memq (car args) cl--lambda-list-keywords)))
 	  (if (consp (car args))
-	      (if (and bind-enquote (cadar args))
-		  (cl-do-arglist (caar args)
-				 (list 'quote (cadr (pop args))))
-		(cl-do-arglist (caar args) (cadr (pop args))))
-	    (cl-do-arglist (pop args) nil))))
+	      (if (and cl--bind-enquote (cl-cadar args))
+		  (cl--do-arglist (caar args)
+				 `',(cadr (pop args)))
+		(cl--do-arglist (caar args) (cadr (pop args))))
+	    (cl--do-arglist (pop args) nil))))
       (if args (error "Malformed argument list %s" save-args)))))
 
-(defun cl-arglist-args (args)
+(defun cl--arglist-args (args)
   (if (nlistp args) (list args)
     (let ((res nil) (kind nil) arg)
       (while (consp args)
 	(setq arg (pop args))
-	(if (memq arg lambda-list-keywords) (setq kind arg)
+	(if (memq arg cl--lambda-list-keywords) (setq kind arg)
 	  (if (eq arg '&cl-defs) (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))))))
+	    (setq res (nconc res (cl--arglist-args arg))))))
       (nconc res (and args (list args))))))
 
 ;;;###autoload
-(defmacro destructuring-bind (args expr &rest body)
-  (let* ((bind-lets nil) (bind-forms nil) (bind-inits nil)
-	 (bind-defs nil) (bind-block 'cl-none) (bind-enquote nil))
-    (cl-do-arglist (or args '(&aux)) expr)
-    (append '(progn) bind-inits
-	    (list (nconc (list 'let* (nreverse bind-lets))
-			 (nreverse bind-forms) body)))))
+(defmacro cl-destructuring-bind (args expr &rest body)
+  "Bind the variables in ARGS to the result of EXPR and execute BODY."
+  (declare (indent 2)
+           (debug (&define cl-macro-list def-form cl-declarations def-body)))
+  (let* ((cl--bind-lets nil) (cl--bind-forms nil) (cl--bind-inits nil)
+	 (cl--bind-defs nil) (cl--bind-block 'cl-none) (cl--bind-enquote nil))
+    (cl--do-arglist (or args '(&aux)) expr)
+    (append '(progn) cl--bind-inits
+	    (list `(let* ,(nreverse cl--bind-lets)
+                     ,@(nreverse cl--bind-forms) ,@body)))))
 
 
-;;; The `eval-when' form.
+;;; The `cl-eval-when' form.
 
 (defvar cl-not-toplevel nil)
 
 ;;;###autoload
-(defmacro eval-when (when &rest body)
+(defmacro cl-eval-when (when &rest 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.
 
 \(fn (WHEN...) BODY...)"
-  (if (and (fboundp 'cl-compiling-file) (cl-compiling-file)
+  (declare (indent 1) (debug ((&rest &or "compile" "load" "eval") body)))
+  (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))
+	    (if comp (cons 'progn (mapcar 'cl--compile-time-too body))
+	      `(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)
+(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))))
+		  form (cons '(cl-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)
+	 (cons 'progn (mapcar 'cl--compile-time-too (cdr form))))
+	((eq (car-safe form) 'cl-eval-when)
 	 (let ((when (nth 1 form)))
 	   (if (or (memq 'eval when) (memq :execute when))
-	       (list* 'eval-when (cons 'compile when) (cddr form))
+	       `(cl-eval-when (compile ,@when) ,@(cddr form))
 	     form)))
 	(t (eval form) form)))
 
 ;;;###autoload
-(defmacro load-time-value (form &optional read-only)
+(defmacro cl-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)))
+  (declare (debug (form &optional sexp)))
+  (if (cl--compiling-file)
+      (let* ((temp (cl-gentemp "--cl-load-time--"))
+	     (set `(set ',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)))
+		  `(lambda (form)
+                     (fset 'byte-compile-file-form
+                           ',(symbol-function 'byte-compile-file-form))
+                     (byte-compile-file-form ',set)
+                     (byte-compile-file-form form)))
 	  (print set (symbol-value 'byte-compile--outbuffer)))
-	(list 'symbol-value (list 'quote temp)))
-    (list 'quote (eval form))))
+	`(symbol-value ',temp))
+    `',(eval form)))
 
 
 ;;; Conditional control structures.
 
 ;;;###autoload
-(defmacro case (expr &rest clauses)
+(defmacro cl-case (expr &rest clauses)
   "Eval EXPR and choose among 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
+If no clause succeeds, cl-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'.
 \n(fn EXPR (KEYLIST BODY...)...)"
-  (let* ((temp (if (cl-simple-expr-p expr 3) expr (make-symbol "--cl-var--")))
+  (declare (indent 1) (debug (form &rest (sexp body))))
+  (let* ((temp (if (cl--simple-expr-p expr 3) expr (make-symbol "--cl-var--")))
 	 (head-list nil)
 	 (body (cons
 		'cond
@@ -550,39 +646,42 @@ Key values are compared by `eql'.
 		 (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))))
+				((eq (car c) 'cl--ecase-error-flag)
+				 `(error "cl-ecase failed: %s, %s"
+                                         ,temp ',(reverse head-list)))
 				((listp (car c))
 				 (setq head-list (append (car c) head-list))
-				 (list 'member* temp (list 'quote (car c))))
+				 `(cl-member ,temp ',(car c)))
 				(t
 				 (if (memq (car c) head-list)
 				     (error "Duplicate key in case: %s"
 					    (car c)))
 				 (push (car c) head-list)
-				 (list 'eql temp (list 'quote (car c)))))
+				 `(eql ,temp ',(car c))))
 			  (or (cdr c) '(nil)))))
 		 clauses))))
     (if (eq temp expr) body
-      (list 'let (list (list temp expr)) body))))
+      `(let ((,temp ,expr)) ,body))))
 
 ;;;###autoload
-(defmacro ecase (expr &rest clauses)
-  "Like `case', but error if no case fits.
+(defmacro cl-ecase (expr &rest clauses)
+  "Like `cl-case', but error if no case fits.
 `otherwise'-clauses are not allowed.
 \n(fn EXPR (KEYLIST BODY...)...)"
-  (list* 'case expr (append clauses '((ecase-error-flag)))))
+  (declare (indent 1) (debug cl-case))
+  `(cl-case ,expr ,@clauses (cl--ecase-error-flag)))
 
 ;;;###autoload
-(defmacro typecase (expr &rest clauses)
+(defmacro cl-typecase (expr &rest clauses)
   "Evals EXPR, chooses among 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
+cl-typecase returns nil.  A TYPE of t or `otherwise' is allowed only in the
 final clause, and matches if no other keys match.
 \n(fn EXPR (TYPE BODY...)...)"
-  (let* ((temp (if (cl-simple-expr-p expr 3) expr (make-symbol "--cl-var--")))
+  (declare (indent 1)
+           (debug (form &rest ([&or cl-type-spec "otherwise"] body))))
+  (let* ((temp (if (cl--simple-expr-p expr 3) expr (make-symbol "--cl-var--")))
 	 (type-list nil)
 	 (body (cons
 		'cond
@@ -590,70 +689,75 @@ final clause, and matches if no other keys match.
 		 (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))))
+				((eq (car c) 'cl--ecase-error-flag)
+				 `(error "cl-etypecase failed: %s, %s"
+                                         ,temp ',(reverse type-list)))
 				(t
 				 (push (car c) type-list)
-				 (cl-make-type-test temp (car c))))
+				 (cl--make-type-test temp (car c))))
 			  (or (cdr c) '(nil)))))
 		 clauses))))
     (if (eq temp expr) body
-      (list 'let (list (list temp expr)) body))))
+      `(let ((,temp ,expr)) ,body))))
 
 ;;;###autoload
-(defmacro etypecase (expr &rest clauses)
-  "Like `typecase', but error if no case fits.
+(defmacro cl-etypecase (expr &rest clauses)
+  "Like `cl-typecase', but error if no case fits.
 `otherwise'-clauses are not allowed.
 \n(fn EXPR (TYPE BODY...)...)"
-  (list* 'typecase expr (append clauses '((ecase-error-flag)))))
+  (declare (indent 1) (debug cl-typecase))
+  `(cl-typecase ,expr ,@clauses (cl--ecase-error-flag)))
 
 
 ;;; Blocks and exits.
 
 ;;;###autoload
-(defmacro block (name &rest body)
+(defmacro cl-block (name &rest body)
   "Define a lexically-scoped block named NAME.
-NAME may be any symbol.  Code inside the BODY forms can call `return-from'
+NAME may be any symbol.  Code inside the BODY forms can call `cl-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))))
+  (declare (indent 1) (debug (symbolp body)))
+  (if (cl--safe-expr-p `(progn ,@body)) `(progn ,@body)
+    `(cl--block-wrapper
+      (catch ',(intern (format "--cl-block-%s--" name))
+        ,@body))))
 
 ;;;###autoload
-(defmacro return (&optional result)
+(defmacro cl-return (&optional result)
   "Return from the block named nil.
-This is equivalent to `(return-from nil RESULT)'."
-  (list 'return-from nil result))
+This is equivalent to `(cl-return-from nil RESULT)'."
+  (declare (debug (&optional form)))
+  `(cl-return-from nil ,result))
 
 ;;;###autoload
-(defmacro return-from (name &optional result)
+(defmacro cl-return-from (name &optional result)
   "Return from the block named NAME.
-This jumps out to the innermost enclosing `(block NAME ...)' form,
+This jumps out to the innermost enclosing `(cl-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."
+  (declare (indent 1) (debug (symbolp &optional form)))
   (let ((name2 (intern (format "--cl-block-%s--" name))))
-    (list 'cl-block-throw (list 'quote name2) result)))
+    `(cl--block-throw ',name2 ,result)))
 
 
-;;; The "loop" macro.
+;;; The "cl-loop" macro.
 
-(defvar loop-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)
+(defvar cl--loop-args) (defvar cl--loop-accum-var) (defvar cl--loop-accum-vars)
+(defvar cl--loop-bindings) (defvar cl--loop-body) (defvar cl--loop-destr-temps)
+(defvar cl--loop-finally) (defvar cl--loop-finish-flag)
+(defvar cl--loop-first-flag)
+(defvar cl--loop-initially) (defvar cl--loop-map-form) (defvar cl--loop-name)
+(defvar cl--loop-result) (defvar cl--loop-result-explicit)
+(defvar cl--loop-result-var) (defvar cl--loop-steps) (defvar cl--loop-symbol-macs)
 
 ;;;###autoload
-(defmacro loop (&rest loop-args)
+(defmacro cl-loop (&rest loop-args)
   "The Common Lisp `loop' macro.
 Valid clauses are:
   for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM,
@@ -668,119 +772,286 @@ Valid clauses are:
   finally return EXPR, named NAME.
 
 \(fn CLAUSE...)"
-  (if (not (memq t (mapcar 'symbolp (delq nil (delq t (copy-list loop-args))))))
-      (list 'block nil (list* 'while t loop-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 loop-args (append loop-args '(cl-end-loop)))
-      (while (not (eq (car loop-args) 'cl-end-loop)) (cl-parse-loop-clause))
-      (if loop-finish-flag
-	  (push `((,loop-finish-flag t)) loop-bindings))
-      (if loop-first-flag
-	  (progn (push `((,loop-first-flag t)) loop-bindings)
-		 (push `(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)))
+  (declare (debug (&rest &or
+                         ;; These are usually followed by a symbol, but it can
+                         ;; actually be any destructuring-bind pattern, which
+                         ;; would erroneously match `form'.
+                         [[&or "for" "as" "with" "and"] sexp]
+                         ;; These are followed by expressions which could
+                         ;; erroneously match `symbolp'.
+                         [[&or "from" "upfrom" "downfrom" "to" "upto" "downto"
+                               "above" "below" "by" "in" "on" "=" "across"
+                               "repeat" "while" "until" "always" "never"
+                               "thereis" "collect" "append" "nconc" "sum"
+                               "count" "maximize" "minimize" "if" "unless"
+                               "return"] form]
+                         ;; Simple default, which covers 99% of the cases.
+                         symbolp form)))
+  (if (not (memq t (mapcar 'symbolp (delq nil (delq t (cl-copy-list loop-args))))))
+      `(cl-block nil (while t ,@loop-args))
+    (let ((cl--loop-args loop-args) (cl--loop-name nil) (cl--loop-bindings nil)
+	  (cl--loop-body nil)	(cl--loop-steps nil)
+	  (cl--loop-result nil)	(cl--loop-result-explicit nil)
+	  (cl--loop-result-var nil) (cl--loop-finish-flag nil)
+	  (cl--loop-accum-var nil)	(cl--loop-accum-vars nil)
+	  (cl--loop-initially nil)	(cl--loop-finally nil)
+	  (cl--loop-map-form nil)   (cl--loop-first-flag nil)
+	  (cl--loop-destr-temps nil) (cl--loop-symbol-macs nil))
+      (setq cl--loop-args (append cl--loop-args '(cl-end-loop)))
+      (while (not (eq (car cl--loop-args) 'cl-end-loop)) (cl-parse-loop-clause))
+      (if cl--loop-finish-flag
+	  (push `((,cl--loop-finish-flag t)) cl--loop-bindings))
+      (if cl--loop-first-flag
+	  (progn (push `((,cl--loop-first-flag t)) cl--loop-bindings)
+		 (push `(setq ,cl--loop-first-flag nil) cl--loop-steps)))
+      (let* ((epilogue (nconc (nreverse cl--loop-finally)
+			      (list (or cl--loop-result-explicit cl--loop-result))))
+	     (ands (cl--loop-build-ands (nreverse cl--loop-body)))
+	     (while-body (nconc (cadr ands) (nreverse cl--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 `(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)
-			  `((if ,loop-finish-flag
-				(progn ,@epilogue) ,loop-result-var)))
+		    (nreverse cl--loop-initially)
+		    (list (if cl--loop-map-form
+			      `(cl-block --cl-finish--
+                                 ,(cl-subst
+                                   (if (eq (car ands) t) while-body
+                                     (cons `(or ,(car ands)
+                                                (cl-return-from --cl-finish--
+                                                  nil))
+                                           while-body))
+                                   '--cl-map cl--loop-map-form))
+			    `(while ,(car ands) ,@while-body)))
+		    (if cl--loop-finish-flag
+			(if (equal epilogue '(nil)) (list cl--loop-result-var)
+			  `((if ,cl--loop-finish-flag
+				(progn ,@epilogue) ,cl--loop-result-var)))
 		      epilogue))))
-	(if loop-result-var (push (list loop-result-var) loop-bindings))
-	(while loop-bindings
-	  (if (cdar loop-bindings)
-	      (setq body (list (cl-loop-let (pop loop-bindings) body t)))
+	(if cl--loop-result-var (push (list cl--loop-result-var) cl--loop-bindings))
+	(while cl--loop-bindings
+	  (if (cdar cl--loop-bindings)
+	      (setq body (list (cl--loop-let (pop cl--loop-bindings) body t)))
 	    (let ((lets nil))
-	      (while (and loop-bindings
-			  (not (cdar loop-bindings)))
-		(push (car (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)))))
+	      (while (and cl--loop-bindings
+			  (not (cdar cl--loop-bindings)))
+		(push (car (pop cl--loop-bindings)) lets))
+	      (setq body (list (cl--loop-let lets body nil))))))
+	(if cl--loop-symbol-macs
+	    (setq body (list `(cl-symbol-macrolet ,cl--loop-symbol-macs ,@body))))
+	`(cl-block ,cl--loop-name ,@body)))))
+
+;; Below is a complete spec for cl-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 valid cl-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 cl-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))
+
+
 
 (defun cl-parse-loop-clause ()		; uses loop-*
-  (let ((word (pop loop-args))
+  (let ((word (pop cl--loop-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 loop-args)
-      (error "Malformed `loop' macro"))
+     ((null cl--loop-args)
+      (error "Malformed `cl-loop' macro"))
 
      ((eq word 'named)
-      (setq loop-name (pop loop-args)))
+      (setq cl--loop-name (pop cl--loop-args)))
 
      ((eq word 'initially)
-      (if (memq (car loop-args) '(do doing)) (pop loop-args))
-      (or (consp (car loop-args)) (error "Syntax error on `initially' clause"))
-      (while (consp (car loop-args))
-	(push (pop loop-args) loop-initially)))
+      (if (memq (car cl--loop-args) '(do doing)) (pop cl--loop-args))
+      (or (consp (car cl--loop-args)) (error "Syntax error on `initially' clause"))
+      (while (consp (car cl--loop-args))
+	(push (pop cl--loop-args) cl--loop-initially)))
 
      ((eq word 'finally)
-      (if (eq (car loop-args) 'return)
-	  (setq loop-result-explicit (or (cl-pop2 loop-args) '(quote nil)))
-	(if (memq (car loop-args) '(do doing)) (pop loop-args))
-	(or (consp (car loop-args)) (error "Syntax error on `finally' clause"))
-	(if (and (eq (caar loop-args) 'return) (null loop-name))
-	    (setq loop-result-explicit (or (nth 1 (pop loop-args)) '(quote nil)))
-	  (while (consp (car loop-args))
-	    (push (pop loop-args) loop-finally)))))
+      (if (eq (car cl--loop-args) 'return)
+	  (setq cl--loop-result-explicit (or (cl-pop2 cl--loop-args) '(quote nil)))
+	(if (memq (car cl--loop-args) '(do doing)) (pop cl--loop-args))
+	(or (consp (car cl--loop-args)) (error "Syntax error on `finally' clause"))
+	(if (and (eq (caar cl--loop-args) 'return) (null cl--loop-name))
+	    (setq cl--loop-result-explicit (or (nth 1 (pop cl--loop-args)) '(quote nil)))
+	  (while (consp (car cl--loop-args))
+	    (push (pop cl--loop-args) cl--loop-finally)))))
 
      ((memq word '(for as))
       (let ((loop-for-bindings nil) (loop-for-sets nil) (loop-for-steps nil)
 	    (ands nil))
 	(while
-	    ;; Use `gensym' rather than `make-symbol'.  It's important that
+	    ;; Use `cl-gensym' rather than `make-symbol'.  It's important that
 	    ;; (not (eq (symbol-name var1) (symbol-name var2))) because
-	    ;; these vars get added to the cl-macro-environment.
-	    (let ((var (or (pop loop-args) (gensym "--cl-var--"))))
-	      (setq word (pop loop-args))
-	      (if (eq word 'being) (setq word (pop loop-args)))
-	      (if (memq word '(the each)) (setq word (pop loop-args)))
+	    ;; these vars get added to the macro-environment.
+	    (let ((var (or (pop cl--loop-args) (cl-gensym "--cl-var--"))))
+	      (setq word (pop cl--loop-args))
+	      (if (eq word 'being) (setq word (pop cl--loop-args)))
+	      (if (memq word '(the each)) (setq word (pop cl--loop-args)))
 	      (if (memq word '(buffer buffers))
-		  (setq word 'in loop-args (cons '(buffer-list) loop-args)))
+		  (setq word 'in cl--loop-args (cons '(buffer-list) cl--loop-args)))
 	      (cond
 
 	       ((memq word '(from downfrom upfrom to downto upto
 			     above below by))
-		(push word loop-args)
-		(if (memq (car loop-args) '(downto above))
-		    (error "Must specify `from' value for downward loop"))
-		(let* ((down (or (eq (car loop-args) 'downfrom)
-				 (memq (caddr loop-args) '(downto above))))
-		       (excl (or (memq (car loop-args) '(above below))
-				 (memq (caddr loop-args) '(above below))))
-		       (start (and (memq (car loop-args) '(from upfrom downfrom))
-				   (cl-pop2 loop-args)))
-		       (end (and (memq (car loop-args)
+		(push word cl--loop-args)
+		(if (memq (car cl--loop-args) '(downto above))
+		    (error "Must specify `from' value for downward cl-loop"))
+		(let* ((down (or (eq (car cl--loop-args) 'downfrom)
+				 (memq (cl-caddr cl--loop-args) '(downto above))))
+		       (excl (or (memq (car cl--loop-args) '(above below))
+				 (memq (cl-caddr cl--loop-args) '(above below))))
+		       (start (and (memq (car cl--loop-args) '(from upfrom downfrom))
+				   (cl-pop2 cl--loop-args)))
+		       (end (and (memq (car cl--loop-args)
 				       '(to upto downto above below))
-				 (cl-pop2 loop-args)))
-		       (step (and (eq (car loop-args) 'by) (cl-pop2 loop-args)))
-		       (end-var (and (not (cl-const-expr-p end))
+				 (cl-pop2 cl--loop-args)))
+		       (step (and (eq (car cl--loop-args) 'by) (cl-pop2 cl--loop-args)))
+		       (end-var (and (not (macroexp-const-p end))
 				     (make-symbol "--cl-var--")))
-		       (step-var (and (not (cl-const-expr-p step))
+		       (step-var (and (not (macroexp-const-p step))
 				      (make-symbol "--cl-var--"))))
 		  (and step (numberp step) (<= step 0)
 		       (error "Loop `by' value is not positive: %s" step))
@@ -791,7 +1062,7 @@ Valid clauses are:
 		  (if end
 		      (push (list
 			     (if down (if excl '> '>=) (if excl '< '<=))
-			     var (or end-var end)) loop-body))
+			     var (or end-var end)) cl--loop-body))
 		  (push (list var (list (if down '- '+) var
 					(or step-var step 1)))
 			loop-for-steps)))
@@ -800,44 +1071,44 @@ Valid clauses are:
 		(let* ((on (eq word 'on))
 		       (temp (if (and on (symbolp var))
 				 var (make-symbol "--cl-var--"))))
-		  (push (list temp (pop loop-args)) loop-for-bindings)
-		  (push (list 'consp temp) loop-body)
+		  (push (list temp (pop cl--loop-args)) loop-for-bindings)
+		  (push `(consp ,temp) cl--loop-body)
 		  (if (eq word 'in-ref)
-		      (push (list var (list 'car temp)) loop-symbol-macs)
+		      (push (list var `(car ,temp)) cl--loop-symbol-macs)
 		    (or (eq temp var)
 			(progn
 			  (push (list var nil) loop-for-bindings)
-			  (push (list var (if on temp (list 'car temp)))
+			  (push (list var (if on temp `(car ,temp)))
 				loop-for-sets))))
 		  (push (list temp
-			      (if (eq (car loop-args) 'by)
-				  (let ((step (cl-pop2 loop-args)))
+			      (if (eq (car cl--loop-args) 'by)
+				  (let ((step (cl-pop2 cl--loop-args)))
 				    (if (and (memq (car-safe step)
 						   '(quote function
-							   function*))
+							   cl-function))
 					     (symbolp (nth 1 step)))
 					(list (nth 1 step) temp)
-				      (list 'funcall step temp)))
-				(list 'cdr temp)))
+				      `(funcall ,step ,temp)))
+				`(cdr ,temp)))
 			loop-for-steps)))
 
 	       ((eq word '=)
-		(let* ((start (pop loop-args))
-		       (then (if (eq (car loop-args) 'then) (cl-pop2 loop-args) start)))
+		(let* ((start (pop cl--loop-args))
+		       (then (if (eq (car cl--loop-args) 'then) (cl-pop2 cl--loop-args) start)))
 		  (push (list var nil) loop-for-bindings)
-		  (if (or ands (eq (car loop-args) 'and))
+		  (if (or ands (eq (car cl--loop-args) 'and))
 		      (progn
 			(push `(,var
-				(if ,(or loop-first-flag
-					 (setq loop-first-flag
+				(if ,(or cl--loop-first-flag
+					 (setq cl--loop-first-flag
 					       (make-symbol "--cl-var--")))
 				    ,start ,var))
 			      loop-for-sets)
 			(push (list var then) loop-for-steps))
 		    (push (list var
 				(if (eq start then) start
-				  `(if ,(or loop-first-flag
-					    (setq loop-first-flag
+				  `(if ,(or cl--loop-first-flag
+					    (setq cl--loop-first-flag
 						  (make-symbol "--cl-var--")))
 				       ,start ,then)))
 			  loop-for-sets))))
@@ -845,80 +1116,79 @@ Valid clauses are:
 	       ((memq word '(across across-ref))
 		(let ((temp-vec (make-symbol "--cl-vec--"))
 		      (temp-idx (make-symbol "--cl-idx--")))
-		  (push (list temp-vec (pop loop-args)) loop-for-bindings)
+		  (push (list temp-vec (pop cl--loop-args)) loop-for-bindings)
 		  (push (list temp-idx -1) loop-for-bindings)
-		  (push (list '< (list 'setq temp-idx (list '1+ temp-idx))
-			      (list 'length temp-vec)) loop-body)
+		  (push `(< (setq ,temp-idx (1+ ,temp-idx))
+                            (length ,temp-vec)) cl--loop-body)
 		  (if (eq word 'across-ref)
-		      (push (list var (list 'aref temp-vec temp-idx))
-			    loop-symbol-macs)
+		      (push (list var `(aref ,temp-vec ,temp-idx))
+			    cl--loop-symbol-macs)
 		    (push (list var nil) loop-for-bindings)
-		    (push (list var (list 'aref temp-vec temp-idx))
+		    (push (list var `(aref ,temp-vec ,temp-idx))
 			  loop-for-sets))))
 
 	       ((memq word '(element elements))
-		(let ((ref (or (memq (car loop-args) '(in-ref of-ref))
-			       (and (not (memq (car loop-args) '(in of)))
+		(let ((ref (or (memq (car cl--loop-args) '(in-ref of-ref))
+			       (and (not (memq (car cl--loop-args) '(in of)))
 				    (error "Expected `of'"))))
-		      (seq (cl-pop2 loop-args))
+		      (seq (cl-pop2 cl--loop-args))
 		      (temp-seq (make-symbol "--cl-seq--"))
-		      (temp-idx (if (eq (car loop-args) 'using)
-				    (if (and (= (length (cadr loop-args)) 2)
-					     (eq (caadr loop-args) 'index))
-					(cadr (cl-pop2 loop-args))
+		      (temp-idx (if (eq (car cl--loop-args) 'using)
+				    (if (and (= (length (cadr cl--loop-args)) 2)
+					     (eq (cl-caadr cl--loop-args) 'index))
+					(cadr (cl-pop2 cl--loop-args))
 				      (error "Bad `using' clause"))
 				  (make-symbol "--cl-idx--"))))
 		  (push (list temp-seq seq) loop-for-bindings)
 		  (push (list temp-idx 0) loop-for-bindings)
 		  (if ref
 		      (let ((temp-len (make-symbol "--cl-len--")))
-			(push (list temp-len (list 'length temp-seq))
+			(push (list temp-len `(length ,temp-seq))
 			      loop-for-bindings)
-			(push (list var (list 'elt temp-seq temp-idx))
-			      loop-symbol-macs)
-			(push (list '< temp-idx temp-len) loop-body))
+			(push (list var `(elt ,temp-seq ,temp-idx))
+			      cl--loop-symbol-macs)
+			(push `(< ,temp-idx ,temp-len) cl--loop-body))
 		    (push (list var nil) loop-for-bindings)
-		    (push (list 'and temp-seq
-				(list 'or (list 'consp temp-seq)
-				      (list '< temp-idx
-					    (list 'length temp-seq))))
-			  loop-body)
-		    (push (list var (list 'if (list 'consp temp-seq)
-					  (list 'pop temp-seq)
-					  (list 'aref temp-seq temp-idx)))
+		    (push `(and ,temp-seq
+				(or (consp ,temp-seq)
+                                    (< ,temp-idx (length ,temp-seq))))
+			  cl--loop-body)
+		    (push (list var `(if (consp ,temp-seq)
+                                         (pop ,temp-seq)
+                                       (aref ,temp-seq ,temp-idx)))
 			  loop-for-sets))
-		  (push (list temp-idx (list '1+ temp-idx))
+		  (push (list temp-idx `(1+ ,temp-idx))
 			loop-for-steps)))
 
 	       ((memq word hash-types)
-		(or (memq (car loop-args) '(in of)) (error "Expected `of'"))
-		(let* ((table (cl-pop2 loop-args))
-		       (other (if (eq (car loop-args) 'using)
-				  (if (and (= (length (cadr loop-args)) 2)
-					   (memq (caadr loop-args) hash-types)
-					   (not (eq (caadr loop-args) word)))
-				      (cadr (cl-pop2 loop-args))
+		(or (memq (car cl--loop-args) '(in of)) (error "Expected `of'"))
+		(let* ((table (cl-pop2 cl--loop-args))
+		       (other (if (eq (car cl--loop-args) 'using)
+				  (if (and (= (length (cadr cl--loop-args)) 2)
+					   (memq (cl-caadr cl--loop-args) hash-types)
+					   (not (eq (cl-caadr cl--loop-args) word)))
+				      (cadr (cl-pop2 cl--loop-args))
 				    (error "Bad `using' clause"))
 				(make-symbol "--cl-var--"))))
 		  (if (memq word '(hash-value hash-values))
 		      (setq var (prog1 other (setq other var))))
-		  (setq loop-map-form
+		  (setq cl--loop-map-form
 			`(maphash (lambda (,var ,other) . --cl-map) ,table))))
 
 	       ((memq word '(symbol present-symbol external-symbol
 			     symbols present-symbols external-symbols))
-		(let ((ob (and (memq (car loop-args) '(in of)) (cl-pop2 loop-args))))
-		  (setq loop-map-form
+		(let ((ob (and (memq (car cl--loop-args) '(in of)) (cl-pop2 cl--loop-args))))
+		  (setq cl--loop-map-form
 			`(mapatoms (lambda (,var) . --cl-map) ,ob))))
 
 	       ((memq word '(overlay overlays extent extents))
 		(let ((buf nil) (from nil) (to nil))
-		  (while (memq (car loop-args) '(in of from to))
-		    (cond ((eq (car loop-args) 'from) (setq from (cl-pop2 loop-args)))
-			  ((eq (car loop-args) 'to) (setq to (cl-pop2 loop-args)))
-			  (t (setq buf (cl-pop2 loop-args)))))
-		  (setq loop-map-form
-			`(cl-map-extents
+		  (while (memq (car cl--loop-args) '(in of from to))
+		    (cond ((eq (car cl--loop-args) 'from) (setq from (cl-pop2 cl--loop-args)))
+			  ((eq (car cl--loop-args) 'to) (setq to (cl-pop2 cl--loop-args)))
+			  (t (setq buf (cl-pop2 cl--loop-args)))))
+		  (setq cl--loop-map-form
+			`(cl--map-overlays
 			  (lambda (,var ,(make-symbol "--cl-var--"))
 			    (progn . --cl-map) nil)
 			  ,buf ,from ,to))))
@@ -927,246 +1197,248 @@ Valid clauses are:
 		(let ((buf nil) (prop nil) (from nil) (to nil)
 		      (var1 (make-symbol "--cl-var1--"))
 		      (var2 (make-symbol "--cl-var2--")))
-		  (while (memq (car loop-args) '(in of property from to))
-		    (cond ((eq (car loop-args) 'from) (setq from (cl-pop2 loop-args)))
-			  ((eq (car loop-args) 'to) (setq to (cl-pop2 loop-args)))
-			  ((eq (car loop-args) 'property)
-			   (setq prop (cl-pop2 loop-args)))
-			  (t (setq buf (cl-pop2 loop-args)))))
+		  (while (memq (car cl--loop-args) '(in of property from to))
+		    (cond ((eq (car cl--loop-args) 'from) (setq from (cl-pop2 cl--loop-args)))
+			  ((eq (car cl--loop-args) 'to) (setq to (cl-pop2 cl--loop-args)))
+			  ((eq (car cl--loop-args) 'property)
+			   (setq prop (cl-pop2 cl--loop-args)))
+			  (t (setq buf (cl-pop2 cl--loop-args)))))
 		  (if (and (consp var) (symbolp (car var)) (symbolp (cdr var)))
 		      (setq var1 (car var) var2 (cdr var))
-		    (push (list var (list 'cons var1 var2)) loop-for-sets))
-		  (setq loop-map-form
-			`(cl-map-intervals
+		    (push (list var `(cons ,var1 ,var2)) loop-for-sets))
+		  (setq cl--loop-map-form
+			`(cl--map-intervals
 			  (lambda (,var1 ,var2) . --cl-map)
 			  ,buf ,prop ,from ,to))))
 
 	       ((memq word key-types)
-		(or (memq (car loop-args) '(in of)) (error "Expected `of'"))
-		(let ((map (cl-pop2 loop-args))
-		      (other (if (eq (car loop-args) 'using)
-				 (if (and (= (length (cadr loop-args)) 2)
-					  (memq (caadr loop-args) key-types)
-					  (not (eq (caadr loop-args) word)))
-				     (cadr (cl-pop2 loop-args))
+		(or (memq (car cl--loop-args) '(in of)) (error "Expected `of'"))
+		(let ((cl-map (cl-pop2 cl--loop-args))
+		      (other (if (eq (car cl--loop-args) 'using)
+				 (if (and (= (length (cadr cl--loop-args)) 2)
+					  (memq (cl-caadr cl--loop-args) key-types)
+					  (not (eq (cl-caadr cl--loop-args) word)))
+				     (cadr (cl-pop2 cl--loop-args))
 				   (error "Bad `using' clause"))
 			       (make-symbol "--cl-var--"))))
 		  (if (memq word '(key-binding key-bindings))
 		      (setq var (prog1 other (setq other var))))
-		  (setq loop-map-form
+		  (setq cl--loop-map-form
 			`(,(if (memq word '(key-seq key-seqs))
-			       'cl-map-keymap-recursively 'map-keymap)
-			  (lambda (,var ,other) . --cl-map) ,map))))
+			       'cl--map-keymap-recursively 'map-keymap)
+			  (lambda (,var ,other) . --cl-map) ,cl-map))))
 
 	       ((memq word '(frame frames screen screens))
 		(let ((temp (make-symbol "--cl-var--")))
 		  (push (list var  '(selected-frame))
 			loop-for-bindings)
 		  (push (list temp nil) loop-for-bindings)
-		  (push (list 'prog1 (list 'not (list 'eq var temp))
-			      (list 'or temp (list 'setq temp var)))
-			loop-body)
-		  (push (list var (list 'next-frame var))
+		  (push `(prog1 (not (eq ,var ,temp))
+                           (or ,temp (setq ,temp ,var)))
+			cl--loop-body)
+		  (push (list var `(next-frame ,var))
 			loop-for-steps)))
 
 	       ((memq word '(window windows))
-		(let ((scr (and (memq (car loop-args) '(in of)) (cl-pop2 loop-args)))
+		(let ((scr (and (memq (car cl--loop-args) '(in of)) (cl-pop2 cl--loop-args)))
 		      (temp (make-symbol "--cl-var--"))
 		      (minip (make-symbol "--cl-minip--")))
 		  (push (list var (if scr
-				      (list 'frame-selected-window scr)
+				      `(frame-selected-window ,scr)
 				    '(selected-window)))
 			loop-for-bindings)
 		  ;; If we started in the minibuffer, we need to
 		  ;; ensure that next-window will bring us back there
 		  ;; at some point.  (Bug#7492).
-		  ;; (Consider using walk-windows instead of loop if
+		  ;; (Consider using walk-windows instead of cl-loop if
 		  ;; you care about such things.)
 		  (push (list minip `(minibufferp (window-buffer ,var)))
 			loop-for-bindings)
 		  (push (list temp nil) loop-for-bindings)
-		  (push (list 'prog1 (list 'not (list 'eq var temp))
-			      (list 'or temp (list 'setq temp var)))
-			loop-body)
-		  (push (list var (list 'next-window var minip))
+		  (push `(prog1 (not (eq ,var ,temp))
+                           (or ,temp (setq ,temp ,var)))
+			cl--loop-body)
+		  (push (list var `(next-window ,var ,minip))
 			loop-for-steps)))
 
 	       (t
+		;; This is an advertised interface: (info "(cl)Other Clauses").
 		(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 loop-args) 'and))
+	      (eq (car cl--loop-args) 'and))
 	  (setq ands t)
-	  (pop loop-args))
+	  (pop cl--loop-args))
 	(if (and ands loop-for-bindings)
-	    (push (nreverse loop-for-bindings) loop-bindings)
-	  (setq loop-bindings (nconc (mapcar 'list loop-for-bindings)
-				     loop-bindings)))
+	    (push (nreverse loop-for-bindings) cl--loop-bindings)
+	  (setq cl--loop-bindings (nconc (mapcar 'list loop-for-bindings)
+				     cl--loop-bindings)))
 	(if loop-for-sets
-	    (push (list 'progn
-			(cl-loop-let (nreverse loop-for-sets) 'setq ands)
-			t) loop-body))
+	    (push `(progn
+                     ,(cl--loop-let (nreverse loop-for-sets) 'setq ands)
+                     t) cl--loop-body))
 	(if loop-for-steps
-	    (push (cons (if ands 'psetq 'setq)
+	    (push (cons (if ands 'cl-psetq 'setq)
 			(apply 'append (nreverse loop-for-steps)))
-		  loop-steps))))
+		  cl--loop-steps))))
 
      ((eq word 'repeat)
       (let ((temp (make-symbol "--cl-var--")))
-	(push (list (list temp (pop loop-args))) loop-bindings)
-	(push (list '>= (list 'setq temp (list '1- temp)) 0) loop-body)))
+	(push (list (list temp (pop cl--loop-args))) cl--loop-bindings)
+	(push `(>= (setq ,temp (1- ,temp)) 0) cl--loop-body)))
 
      ((memq word '(collect collecting))
-      (let ((what (pop loop-args))
-	    (var (cl-loop-handle-accum nil 'nreverse)))
-	(if (eq var loop-accum-var)
-	    (push (list 'progn (list 'push what var) t) loop-body)
-	  (push (list 'progn
-		      (list 'setq var (list 'nconc var (list 'list what)))
-		      t) loop-body))))
+      (let ((what (pop cl--loop-args))
+	    (var (cl--loop-handle-accum nil 'nreverse)))
+	(if (eq var cl--loop-accum-var)
+	    (push `(progn (push ,what ,var) t) cl--loop-body)
+	  (push `(progn
+                   (setq ,var (nconc ,var (list ,what)))
+                   t) cl--loop-body))))
 
      ((memq word '(nconc nconcing append appending))
-      (let ((what (pop loop-args))
-	    (var (cl-loop-handle-accum nil 'nreverse)))
-	(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)))
+      (let ((what (pop cl--loop-args))
+	    (var (cl--loop-handle-accum nil 'nreverse)))
+	(push `(progn
+                 (setq ,var
+                       ,(if (eq var cl--loop-accum-var)
+                            `(nconc
+                              (,(if (memq word '(nconc nconcing))
+                                    #'nreverse #'reverse)
+                               ,what)
+                              ,var)
+                          `(,(if (memq word '(nconc nconcing))
+                                 #'nconc #'append)
+                            ,var ,what))) t) cl--loop-body)))
 
      ((memq word '(concat concating))
-      (let ((what (pop loop-args))
-	    (var (cl-loop-handle-accum "")))
-	(push (list 'progn (list 'callf 'concat var what) t) loop-body)))
+      (let ((what (pop cl--loop-args))
+	    (var (cl--loop-handle-accum "")))
+	(push `(progn (cl-callf concat ,var ,what) t) cl--loop-body)))
 
      ((memq word '(vconcat vconcating))
-      (let ((what (pop loop-args))
-	    (var (cl-loop-handle-accum [])))
-	(push (list 'progn (list 'callf 'vconcat var what) t) loop-body)))
+      (let ((what (pop cl--loop-args))
+	    (var (cl--loop-handle-accum [])))
+	(push `(progn (cl-callf vconcat ,var ,what) t) cl--loop-body)))
 
      ((memq word '(sum summing))
-      (let ((what (pop loop-args))
-	    (var (cl-loop-handle-accum 0)))
-	(push (list 'progn (list 'incf var what) t) loop-body)))
+      (let ((what (pop cl--loop-args))
+	    (var (cl--loop-handle-accum 0)))
+	(push `(progn (cl-incf ,var ,what) t) cl--loop-body)))
 
      ((memq word '(count counting))
-      (let ((what (pop loop-args))
-	    (var (cl-loop-handle-accum 0)))
-	(push (list 'progn (list 'if what (list 'incf var)) t) loop-body)))
+      (let ((what (pop cl--loop-args))
+	    (var (cl--loop-handle-accum 0)))
+	(push `(progn (if ,what (cl-incf ,var)) t) cl--loop-body)))
 
      ((memq word '(minimize minimizing maximize maximizing))
-      (let* ((what (pop loop-args))
-	     (temp (if (cl-simple-expr-p what) what (make-symbol "--cl-var--")))
-	     (var (cl-loop-handle-accum nil))
+      (let* ((what (pop cl--loop-args))
+	     (temp (if (cl--simple-expr-p what) what (make-symbol "--cl-var--")))
+	     (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))))
-	(push (list 'progn (if (eq temp what) set
-			     (list 'let (list (list temp what)) set))
-		    t) loop-body)))
+	     (set `(setq ,var (if ,var (,func ,var ,temp) ,temp))))
+	(push `(progn ,(if (eq temp what) set
+                         `(let ((,temp ,what)) ,set))
+                      t) cl--loop-body)))
 
      ((eq word 'with)
       (let ((bindings nil))
-	(while (progn (push (list (pop loop-args)
-				  (and (eq (car loop-args) '=) (cl-pop2 loop-args)))
+	(while (progn (push (list (pop cl--loop-args)
+				  (and (eq (car cl--loop-args) '=) (cl-pop2 cl--loop-args)))
 			    bindings)
-		      (eq (car loop-args) 'and))
-	  (pop loop-args))
-	(push (nreverse bindings) loop-bindings)))
+		      (eq (car cl--loop-args) 'and))
+	  (pop cl--loop-args))
+	(push (nreverse bindings) cl--loop-bindings)))
 
      ((eq word 'while)
-      (push (pop loop-args) loop-body))
+      (push (pop cl--loop-args) cl--loop-body))
 
      ((eq word 'until)
-      (push (list 'not (pop loop-args)) loop-body))
+      (push `(not ,(pop cl--loop-args)) cl--loop-body))
 
      ((eq word 'always)
-      (or loop-finish-flag (setq loop-finish-flag (make-symbol "--cl-flag--")))
-      (push (list 'setq loop-finish-flag (pop loop-args)) loop-body)
-      (setq loop-result t))
+      (or cl--loop-finish-flag (setq cl--loop-finish-flag (make-symbol "--cl-flag--")))
+      (push `(setq ,cl--loop-finish-flag ,(pop cl--loop-args)) cl--loop-body)
+      (setq cl--loop-result t))
 
      ((eq word 'never)
-      (or loop-finish-flag (setq loop-finish-flag (make-symbol "--cl-flag--")))
-      (push (list 'setq loop-finish-flag (list 'not (pop loop-args)))
-	    loop-body)
-      (setq loop-result t))
+      (or cl--loop-finish-flag (setq cl--loop-finish-flag (make-symbol "--cl-flag--")))
+      (push `(setq ,cl--loop-finish-flag (not ,(pop cl--loop-args)))
+	    cl--loop-body)
+      (setq cl--loop-result t))
 
      ((eq word 'thereis)
-      (or loop-finish-flag (setq loop-finish-flag (make-symbol "--cl-flag--")))
-      (or loop-result-var (setq loop-result-var (make-symbol "--cl-var--")))
-      (push (list 'setq loop-finish-flag
-		  (list 'not (list 'setq loop-result-var (pop loop-args))))
-	    loop-body))
+      (or cl--loop-finish-flag (setq cl--loop-finish-flag (make-symbol "--cl-flag--")))
+      (or cl--loop-result-var (setq cl--loop-result-var (make-symbol "--cl-var--")))
+      (push `(setq ,cl--loop-finish-flag
+                   (not (setq ,cl--loop-result-var ,(pop cl--loop-args))))
+	    cl--loop-body))
 
      ((memq word '(if when unless))
-      (let* ((cond (pop loop-args))
-	     (then (let ((loop-body nil))
+      (let* ((cond (pop cl--loop-args))
+	     (then (let ((cl--loop-body nil))
 		     (cl-parse-loop-clause)
-		     (cl-loop-build-ands (nreverse loop-body))))
-	     (else (let ((loop-body nil))
-		     (if (eq (car loop-args) 'else)
-			 (progn (pop loop-args) (cl-parse-loop-clause)))
-		     (cl-loop-build-ands (nreverse loop-body))))
+		     (cl--loop-build-ands (nreverse cl--loop-body))))
+	     (else (let ((cl--loop-body nil))
+		     (if (eq (car cl--loop-args) 'else)
+			 (progn (pop cl--loop-args) (cl-parse-loop-clause)))
+		     (cl--loop-build-ands (nreverse cl--loop-body))))
 	     (simple (and (eq (car then) t) (eq (car else) t))))
-	(if (eq (car loop-args) 'end) (pop loop-args))
+	(if (eq (car cl--loop-args) 'end) (pop cl--loop-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)
+	  (if (cl--expr-contains form 'it)
 	      (let ((temp (make-symbol "--cl-var--")))
-		(push (list temp) loop-bindings)
-		(setq form (list* 'if (list 'setq temp cond)
-				  (subst temp 'it form))))
-	    (setq form (list* 'if cond form)))
-	  (push (if simple (list 'progn form t) form) loop-body))))
+		(push (list temp) cl--loop-bindings)
+		(setq form `(if (setq ,temp ,cond)
+                                ,@(cl-subst temp 'it form))))
+	    (setq form `(if ,cond ,@form)))
+	  (push (if simple `(progn ,form t) form) cl--loop-body))))
 
      ((memq word '(do doing))
       (let ((body nil))
-	(or (consp (car loop-args)) (error "Syntax error on `do' clause"))
-	(while (consp (car loop-args)) (push (pop loop-args) body))
-	(push (cons 'progn (nreverse (cons t body))) loop-body)))
+	(or (consp (car cl--loop-args)) (error "Syntax error on `do' clause"))
+	(while (consp (car cl--loop-args)) (push (pop cl--loop-args) body))
+	(push (cons 'progn (nreverse (cons t body))) cl--loop-body)))
 
      ((eq word 'return)
-      (or loop-finish-flag (setq loop-finish-flag (make-symbol "--cl-var--")))
-      (or loop-result-var (setq loop-result-var (make-symbol "--cl-var--")))
-      (push (list 'setq loop-result-var (pop loop-args)
-		  loop-finish-flag nil) loop-body))
+      (or cl--loop-finish-flag (setq cl--loop-finish-flag (make-symbol "--cl-var--")))
+      (or cl--loop-result-var (setq cl--loop-result-var (make-symbol "--cl-var--")))
+      (push `(setq ,cl--loop-result-var ,(pop cl--loop-args)
+                   ,cl--loop-finish-flag nil) cl--loop-body))
 
      (t
+      ;; This is an advertised interface: (info "(cl)Other Clauses").
       (let ((handler (and (symbolp word) (get word 'cl-loop-handler))))
-	(or handler (error "Expected a loop keyword, found %s" word))
+	(or handler (error "Expected a cl-loop keyword, found %s" word))
 	(funcall handler))))
-    (if (eq (car loop-args) 'and)
-	(progn (pop loop-args) (cl-parse-loop-clause)))))
+    (if (eq (car cl--loop-args) 'and)
+	(progn (pop cl--loop-args) (cl-parse-loop-clause)))))
 
-(defun cl-loop-let (specs body par)   ; uses loop-*
+(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))))
+    (while (and p (or (symbolp (car-safe (car p))) (null (cl-cadar p))))
       (setq p (cdr p)))
     (and par p
 	 (progn
 	   (setq par nil p specs)
 	   (while p
-	     (or (cl-const-expr-p (cadar p))
+	     (or (macroexp-const-p (cl-cadar p))
 		 (let ((temp (make-symbol "--cl-var--")))
-		   (push (list temp (cadar p)) temps)
+		   (push (list temp (cl-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 (pop specs)))
-		 (temp (cdr (or (assq spec loop-destr-temps)
+		 (temp (cdr (or (assq spec cl--loop-destr-temps)
 				(car (push (cons spec (or (last spec 0)
 							  (make-symbol "--cl-var--")))
-					   loop-destr-temps))))))
+					   cl--loop-destr-temps))))))
 	    (push (list temp expr) new)
 	    (while (consp spec)
 	      (push (list (pop spec)
@@ -1175,29 +1447,36 @@ Valid clauses are:
 	    (setq specs (nconc (nreverse nspecs) specs)))
 	(push (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 loop-*
-  (if (eq (car loop-args) 'into)
-      (let ((var (cl-pop2 loop-args)))
-	(or (memq var loop-accum-vars)
-	    (progn (push (list (list var def)) loop-bindings)
-		   (push var loop-accum-vars)))
+	(let ((set (cons (if par 'cl-psetq 'setq) (apply 'nconc (nreverse new)))))
+	  (if temps `(let* ,(nreverse temps) ,set) set))
+      `(,(if par 'let 'let*)
+        ,(nconc (nreverse temps) (nreverse new)) ,@body))))
+
+(defun cl--loop-handle-accum (def &optional func)   ; uses loop-*
+  (if (eq (car cl--loop-args) 'into)
+      (let ((var (cl-pop2 cl--loop-args)))
+	(or (memq var cl--loop-accum-vars)
+	    (progn (push (list (list var def)) cl--loop-bindings)
+		   (push var cl--loop-accum-vars)))
 	var)
-    (or loop-accum-var
+    (or cl--loop-accum-var
 	(progn
-	  (push (list (list (setq loop-accum-var (make-symbol "--cl-var--")) 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)
+	  (push (list (list (setq cl--loop-accum-var (make-symbol "--cl-var--")) def))
+		   cl--loop-bindings)
+	  (setq cl--loop-result (if func (list func cl--loop-accum-var)
+			      cl--loop-accum-var))
+	  cl--loop-accum-var))))
+
+(defun cl--loop-build-ands (clauses)
+  "Return various representations of (and . CLAUSES).
+CLAUSES is a list of Elisp expressions, where clauses of the form
+\(progn E1 E2 E3 .. t) are the focus of particular optimizations.
+The return value has shape (COND BODY COMBO)
+such that COMBO is equivalent to (and . CLAUSES)."
   (let ((ands nil)
 	(body nil))
+    ;; Look through `clauses', trying to optimize (progn ,@A t) (progn ,@B) ,@C
+    ;; into (progn ,@A ,@B) ,@C.
     (while clauses
       (if (and (eq (car-safe (car clauses)) 'progn)
 	       (eq (car (last (car clauses))) t))
@@ -1205,9 +1484,10 @@ Valid clauses are:
 	      (setq clauses (cons (nconc (butlast (car clauses))
 					 (if (eq (car-safe (cadr clauses))
 						 'progn)
-					     (cdadr clauses)
+					     (cl-cdadr clauses)
 					   (list (cadr clauses))))
 				  (cddr clauses)))
+            ;; A final (progn ,@A t) is moved outside of the `and'.
 	    (setq body (cdr (butlast (pop clauses)))))
 	(push (pop clauses) ands)))
     (setq ands (or (nreverse ands) (list t)))
@@ -1222,363 +1502,401 @@ Valid clauses are:
 ;;; Other iteration control structures.
 
 ;;;###autoload
-(defmacro do (steps endtest &rest body)
+(defmacro cl-do (steps endtest &rest body)
   "The Common Lisp `do' loop.
 
 \(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)"
+  (declare (indent 2)
+           (debug
+            ((&rest &or symbolp (symbolp &optional form form))
+             (form body)
+             cl-declarations body)))
   (cl-expand-do-loop steps endtest body nil))
 
 ;;;###autoload
-(defmacro do* (steps endtest &rest body)
+(defmacro cl-do* (steps endtest &rest body)
   "The Common Lisp `do*' loop.
 
 \(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)"
+  (declare (indent 2) (debug cl-do))
   (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)))))
+  `(cl-block nil
+     (,(if star 'let* 'let)
+      ,(mapcar (lambda (c) (if (consp c) (list (car c) (nth 1 c)) c))
+               steps)
+      (while (not ,(car endtest))
+        ,@body
+        ,@(let ((sets (mapcar (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 'cl-psetq)
+                             (apply 'append sets))))))
+      ,@(or (cdr endtest) '(nil)))))
 
 ;;;###autoload
-(defmacro dolist (spec &rest body)
+(defmacro cl-dolist (spec &rest 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.
 An implicit nil block is established around the loop.
 
 \(fn (VAR LIST [RESULT]) BODY...)"
-  (let ((temp (make-symbol "--cl-dolist-temp--")))
-    ;; FIXME: Copy&pasted from subr.el.
-    `(block nil
-       ;; This is not a reliable test, but it does not matter because both
-       ;; semantics are acceptable, tho one is slightly faster with dynamic
-       ;; scoping and the other is slightly faster (and has cleaner semantics)
-       ;; with lexical scoping.
-       ,(if lexical-binding
-            `(let ((,temp ,(nth 1 spec)))
-               (while ,temp
-                 (let ((,(car spec) (car ,temp)))
-                   ,@body
-                   (setq ,temp (cdr ,temp))))
-               ,@(if (cdr (cdr spec))
-                     ;; FIXME: This let often leads to "unused var" warnings.
-                     `((let ((,(car spec) nil)) ,@(cdr (cdr spec))))))
-          `(let ((,temp ,(nth 1 spec))
-                 ,(car spec))
-             (while ,temp
-               (setq ,(car spec) (car ,temp))
-               ,@body
-               (setq ,temp (cdr ,temp)))
-             ,@(if (cdr (cdr spec))
-                   `((setq ,(car spec) nil) ,@(cddr spec))))))))
+  (declare (debug ((symbolp form &optional form) cl-declarations body))
+           (indent 1))
+  (let ((loop `(dolist ,spec ,@body)))
+    (if (advice-member-p #'cl--wrap-in-nil-block 'dolist)
+        loop `(cl-block nil ,loop))))
 
 ;;;###autoload
-(defmacro dotimes (spec &rest body)
+(defmacro cl-dotimes (spec &rest 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.
 
 \(fn (VAR COUNT [RESULT]) BODY...)"
-  (let ((temp (make-symbol "--cl-dotimes-temp--"))
-	(end (nth 1 spec)))
-    ;; FIXME: Copy&pasted from subr.el.
-    `(block nil
-       ;; This is not a reliable test, but it does not matter because both
-       ;; semantics are acceptable, tho one is slightly faster with dynamic
-       ;; scoping and the other has cleaner semantics.
-       ,(if lexical-binding
-            (let ((counter '--dotimes-counter--))
-              `(let ((,temp ,end)
-                     (,counter 0))
-                 (while (< ,counter ,temp)
-                   (let ((,(car spec) ,counter))
-                     ,@body)
-                   (setq ,counter (1+ ,counter)))
-                 ,@(if (cddr spec)
-                       ;; FIXME: This let often leads to "unused var" warnings.
-                       `((let ((,(car spec) ,counter)) ,@(cddr spec))))))
-          `(let ((,temp ,end)
-                 (,(car spec) 0))
-             (while (< ,(car spec) ,temp)
-               ,@body
-               (incf ,(car spec)))
-             ,@(cdr (cdr spec)))))))
+  (declare (debug cl-dolist) (indent 1))
+  (let ((loop `(dotimes ,spec ,@body)))
+    (if (advice-member-p #'cl--wrap-in-nil-block 'dotimes)
+        loop `(cl-block nil ,loop))))
 
 ;;;###autoload
-(defmacro do-symbols (spec &rest body)
+(defmacro cl-do-symbols (spec &rest body)
   "Loop over all symbols.
 Evaluate BODY with VAR bound to each interned symbol, or to each symbol
 from OBARRAY.
 
 \(fn (VAR [OBARRAY [RESULT]]) BODY...)"
+  (declare (indent 1)
+           (debug ((symbolp &optional form form) cl-declarations body)))
   ;; 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))))
+  `(cl-block nil
+     (let (,(car spec))
+       (mapatoms #'(lambda (,(car spec)) ,@body)
+                 ,@(and (cadr spec) (list (cadr spec))))
+       ,(cl-caddr spec))))
 
 ;;;###autoload
-(defmacro do-all-symbols (spec &rest body)
-  (list* 'do-symbols (list (car spec) nil (cadr spec)) body))
+(defmacro cl-do-all-symbols (spec &rest body)
+  "Like `cl-do-symbols', but use the default obarray.
+
+\(fn (VAR [RESULT]) BODY...)"
+  (declare (indent 1) (debug ((symbolp &optional form) cl-declarations body)))
+  `(cl-do-symbols (,(car spec) nil ,(cadr spec)) ,@body))
 
 
 ;;; Assignments.
 
 ;;;###autoload
-(defmacro psetq (&rest args)
+(defmacro cl-psetq (&rest args)
   "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.
 
 \(fn SYM VAL SYM VAL ...)"
-  (cons 'psetf args))
+  (declare (debug setq))
+  (cons 'cl-psetf args))
 
 
 ;;; Binding control structures.
 
 ;;;###autoload
-(defmacro progv (symbols values &rest body)
+(defmacro cl-progv (symbols values &rest 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
+second list (or to nil 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))))
+  (declare (indent 2) (debug (form form body)))
+  (let ((bodyfun (make-symbol "cl--progv-body"))
+        (binds (make-symbol "binds"))
+        (syms (make-symbol "syms"))
+        (vals (make-symbol "vals")))
+    `(progn
+       (defvar ,bodyfun)
+       (let* ((,syms ,symbols)
+              (,vals ,values)
+              (,bodyfun (lambda () ,@body))
+              (,binds ()))
+         (while ,syms
+           (push (list (pop ,syms) (list 'quote (pop ,vals))) ,binds))
+         (eval (list 'let ,binds '(funcall ,bodyfun)))))))
+
+(defvar cl--labels-convert-cache nil)
+
+(defun cl--labels-convert (f)
+  "Special macro-expander to rename (function F) references in `cl-labels'."
+  (cond
+   ;; ¡¡Big Ugly Hack!! We can't use a compiler-macro because those are checked
+   ;; *after* handling `function', but we want to stop macroexpansion from
+   ;; being applied infinitely, so we use a cache to return the exact `form'
+   ;; being expanded even though we don't receive it.
+   ((eq f (car cl--labels-convert-cache)) (cdr cl--labels-convert-cache))
+   (t
+    (let ((found (assq f macroexpand-all-environment)))
+      (if (and found (ignore-errors
+                       (eq (cadr (cl-caddr found)) 'cl-labels-args)))
+          (cadr (cl-caddr (cl-cadddr found)))
+        (let ((res `(function ,f)))
+          (setq cl--labels-convert-cache (cons f res))
+          res))))))
+
+;;;###autoload
+(defmacro cl-flet (bindings &rest body)
+  "Make local function definitions.
+Like `cl-labels' but the definitions are not recursive.
+
+\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
+  (declare (indent 1) (debug ((&rest (cl-defun)) cl-declarations body)))
+  (let ((binds ()) (newenv macroexpand-all-environment))
+    (dolist (binding bindings)
+      (let ((var (make-symbol (format "--cl-%s--" (car binding)))))
+	(push (list var `(cl-function (lambda . ,(cdr binding)))) binds)
+	(push (cons (car binding)
+                    `(lambda (&rest cl-labels-args)
+                       (cl-list* 'funcall ',var
+                                 cl-labels-args)))
+              newenv)))
+    `(let ,(nreverse binds)
+       ,@(macroexp-unprogn
+          (macroexpand-all
+           `(progn ,@body)
+           ;; Don't override lexical-let's macro-expander.
+           (if (assq 'function newenv) newenv
+             (cons (cons 'function #'cl--labels-convert) newenv)))))))
 
-;;; This should really have some way to shadow 'byte-compile properties, etc.
 ;;;###autoload
-(defmacro flet (bindings &rest body)
-  "Make temporary function definitions.
-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).
+(defmacro cl-flet* (bindings &rest body)
+  "Make local function definitions.
+Like `cl-flet' but the definitions can refer to previous ones.
 
 \(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
-  (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))))))
-	       (when (cl-compiling-file)
-		 ;; Bug#411.  It would be nice to fix this.
-		 (and (get (car x) 'byte-compile)
-		      (error "Byte-compiling a redefinition of `%s' \
-will not work - use `labels' instead" (symbol-name (car x))))
-		 ;; FIXME This affects the rest of the file, when it
-		 ;; should be restricted to the flet body.
-		 (and (boundp 'byte-compile-function-environment)
-		      (push (cons (car x) (eval func))
-			    byte-compile-function-environment)))
-	       (list (list 'symbol-function (list 'quote (car x))) func))))
-	  bindings)
-	 body))
+  (declare (indent 1) (debug cl-flet))
+  (cond
+   ((null bindings) (macroexp-progn body))
+   ((null (cdr bindings)) `(cl-flet ,bindings ,@body))
+   (t `(cl-flet (,(pop bindings)) (cl-flet* ,bindings ,@body)))))
 
 ;;;###autoload
-(defmacro labels (bindings &rest body)
+(defmacro cl-labels (bindings &rest body)
   "Make temporary function bindings.
-This is like `flet', except the bindings are lexical instead of dynamic.
-Unlike `flet', this macro is fully compliant with the Common Lisp standard.
+The bindings can be recursive and the scoping is lexical, but capturing them
+in closures will only work if `lexical-binding' is in use.
 
 \(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
-  (let ((vars nil) (sets nil) (cl-macro-environment cl-macro-environment))
-    (while bindings
-      ;; Use `gensym' rather than `make-symbol'.  It's important that
-      ;; (not (eq (symbol-name var1) (symbol-name var2))) because these
-      ;; vars get added to the cl-macro-environment.
-      (let ((var (gensym "--cl-var--")))
-	(push var vars)
-	(push (list 'function* (cons 'lambda (cdar bindings))) sets)
-	(push var sets)
-	(push (list (car (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)))
+  (declare (indent 1) (debug cl-flet))
+  (let ((binds ()) (newenv macroexpand-all-environment))
+    (dolist (binding bindings)
+      (let ((var (make-symbol (format "--cl-%s--" (car binding)))))
+	(push (list var `(cl-function (lambda . ,(cdr binding)))) binds)
+	(push (cons (car binding)
+                    `(lambda (&rest cl-labels-args)
+                       (cl-list* 'funcall ',var
+                                 cl-labels-args)))
+              newenv)))
+    (macroexpand-all `(letrec ,(nreverse binds) ,@body)
+                     ;; Don't override lexical-let's macro-expander.
+                     (if (assq 'function newenv) newenv
+                       (cons (cons 'function #'cl--labels-convert) newenv)))))
 
 ;; The following ought to have a better definition for use with newer
 ;; byte compilers.
 ;;;###autoload
-(defmacro macrolet (bindings &rest body)
+(defmacro cl-macrolet (bindings &rest body)
   "Make temporary macro definitions.
-This is like `flet', but for macros instead of functions.
+This is like `cl-flet', but for macros instead of functions.
 
 \(fn ((NAME ARGLIST BODY...) ...) FORM...)"
+  (declare (indent 1)
+           (debug
+            ((&rest (&define name (&rest arg) cl-declarations-or-string
+                             def-body))
+             cl-declarations body)))
   (if (cdr bindings)
-      (list 'macrolet
-	    (list (car bindings)) (list* 'macrolet (cdr bindings) body))
+      `(cl-macrolet (,(car bindings)) (cl-macrolet ,(cdr bindings) ,@body))
     (if (null bindings) (cons 'progn body)
       (let* ((name (caar bindings))
-	     (res (cl-transform-lambda (cdar bindings) name)))
+	     (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))))))
+	(macroexpand-all (cons 'progn body)
+                         (cons (cons name `(lambda ,@(cdr res)))
+                               macroexpand-all-environment))))))
+
+(defconst cl--old-macroexpand
+  (if (and (boundp 'cl--old-macroexpand)
+           (eq (symbol-function 'macroexpand)
+               #'cl--sm-macroexpand))
+      cl--old-macroexpand
+    (symbol-function 'macroexpand)))
+
+(defun cl--sm-macroexpand (exp &optional env)
+  "Special macro expander used inside `cl-symbol-macrolet'.
+This function replaces `macroexpand' during macro expansion
+of `cl-symbol-macrolet', and does the same thing as `macroexpand'
+except that it additionally expands symbol macros."
+  (let ((macroexpand-all-environment env))
+    (while
+        (progn
+          (setq exp (funcall cl--old-macroexpand exp env))
+          (pcase exp
+            ((pred symbolp)
+             ;; Perform symbol-macro expansion.
+             (when (cdr (assq (symbol-name exp) env))
+               (setq exp (cadr (assq (symbol-name exp) env)))))
+            (`(setq . ,_)
+             ;; Convert setq to setf if required by symbol-macro expansion.
+             (let* ((args (mapcar (lambda (f) (cl--sm-macroexpand f env))
+                                  (cdr exp)))
+                    (p args))
+               (while (and p (symbolp (car p))) (setq p (cddr p)))
+               (if p (setq exp (cons 'setf args))
+                 (setq exp (cons 'setq args))
+                 ;; Don't loop further.
+                 nil)))
+            (`(,(or `let `let*) . ,(or `(,bindings . ,body) dontcare))
+             ;; CL's symbol-macrolet treats re-bindings as candidates for
+             ;; expansion (turning the let into a letf if needed), contrary to
+             ;; Common-Lisp where such re-bindings hide the symbol-macro.
+             (let ((letf nil) (found nil) (nbs ()))
+               (dolist (binding bindings)
+                 (let* ((var (if (symbolp binding) binding (car binding)))
+                        (sm (assq (symbol-name var) env)))
+                   (push (if (not (cdr sm))
+                             binding
+                           (let ((nexp (cadr sm)))
+                             (setq found t)
+                             (unless (symbolp nexp) (setq letf t))
+                             (cons nexp (cdr-safe binding))))
+                         nbs)))
+               (when found
+                 (setq exp `(,(if letf
+                                  (if (eq (car exp) 'let) 'cl-letf 'cl-letf*)
+                                (car exp))
+                             ,(nreverse nbs)
+                             ,@body)))))
+            ;; FIXME: The behavior of CL made sense in a dynamically scoped
+            ;; language, but for lexical scoping, Common-Lisp's behavior might
+            ;; make more sense (and indeed, CL behaves like Common-Lisp w.r.t
+            ;; lexical-let), so maybe we should adjust the behavior based on
+            ;; the use of lexical-binding.
+            ;; (`(,(or `let `let*) . ,(or `(,bindings . ,body) dontcare))
+            ;;  (let ((nbs ()) (found nil))
+            ;;    (dolist (binding bindings)
+            ;;      (let* ((var (if (symbolp binding) binding (car binding)))
+            ;;             (name (symbol-name var))
+            ;;             (val (and found (consp binding) (eq 'let* (car exp))
+            ;;                       (list (macroexpand-all (cadr binding)
+            ;;                                              env)))))
+            ;;        (push (if (assq name env)
+            ;;                  ;; This binding should hide its symbol-macro,
+            ;;                  ;; but given the way macroexpand-all works, we
+            ;;                  ;; can't prevent application of `env' to the
+            ;;                  ;; sub-expressions, so we need to α-rename this
+            ;;                  ;; variable instead.
+            ;;                  (let ((nvar (make-symbol
+            ;;                               (copy-sequence name))))
+            ;;                    (setq found t)
+            ;;                    (push (list name nvar) env)
+            ;;                    (cons nvar (or val (cdr-safe binding))))
+            ;;                (if val (cons var val) binding))
+            ;;              nbs)))
+            ;;    (when found
+            ;;      (setq exp `(,(car exp)
+            ;;                  ,(nreverse nbs)
+            ;;                  ,@(macroexp-unprogn
+            ;;                     (macroexpand-all (macroexp-progn body)
+            ;;                                      env)))))
+            ;;    nil))
+            )))
+    exp))
 
 ;;;###autoload
-(defmacro symbol-macrolet (bindings &rest body)
+(defmacro cl-symbol-macrolet (bindings &rest body)
   "Make symbol macro definitions.
 Within the body FORMs, references to the variable NAME will be replaced
 by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...).
 
 \(fn ((NAME EXPANSION) ...) FORM...)"
-  (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)
-;;;###autoload
-(defmacro lexical-let (bindings &rest body)
-  "Like `let', but lexically scoped.
-The main visible difference is that lambdas inside BODY will create
-lexical closures as in Common Lisp.
-\n(fn BINDINGS BODY)"
-  (let* ((cl-closure-vars cl-closure-vars)
-	 (vars (mapcar (function
-			(lambda (x)
-			  (or (consp x) (setq x (list x)))
-			  (push (make-symbol (format "--cl-%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))))
-
-;;;###autoload
-(defmacro lexical-let* (bindings &rest body)
-  "Like `let*', but lexically scoped.
-The main visible difference is that lambdas inside BODY, and in
-successive bindings within BINDINGS, will create lexical closures
-as in Common Lisp.  This is similar to the behavior of `let*' in
-Common Lisp.
-\n(fn BINDINGS BODY)"
-  (if (null bindings) (cons 'progn body)
-    (setq bindings (reverse bindings))
-    (while bindings
-      (setq body (list (list* 'lexical-let (list (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)))
-
+  (declare (indent 1) (debug ((&rest (symbol sexp)) cl-declarations body)))
+  (cond
+   ((cdr bindings)
+    `(cl-symbol-macrolet (,(car bindings))
+       (cl-symbol-macrolet ,(cdr bindings) ,@body)))
+   ((null bindings) (macroexp-progn body))
+   (t
+    (let ((previous-macroexpand (symbol-function 'macroexpand)))
+      (unwind-protect
+          (progn
+            (fset 'macroexpand #'cl--sm-macroexpand)
+            ;; FIXME: For N bindings, this will traverse `body' N times!
+            (macroexpand-all (cons 'progn body)
+                             (cons (list (symbol-name (caar bindings))
+                                         (cl-cadar bindings))
+                                   macroexpand-all-environment)))
+        (fset 'macroexpand previous-macroexpand))))))
 
 ;;; Multiple values.
 
 ;;;###autoload
-(defmacro multiple-value-bind (vars form &rest body)
+(defmacro cl-multiple-value-bind (vars form &rest 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
+is analogous to the Common Lisp `cl-multiple-value-bind' macro, using lists to
+simulate true multiple return values.  For compatibility, (cl-values A B C) is
 a synonym for (list A B C).
 
 \(fn (SYM...) FORM BODY)"
+  (declare (indent 2) (debug ((&rest symbolp) form body)))
   (let ((temp (make-symbol "--cl-var--")) (n -1))
-    (list* 'let* (cons (list temp form)
-		       (mapcar (function
-				(lambda (v)
-				  (list v (list 'nth (setq n (1+ n)) temp))))
-			       vars))
-	   body)))
+    `(let* ((,temp ,form)
+            ,@(mapcar (lambda (v)
+                        (list v `(nth ,(setq n (1+ n)) ,temp)))
+                      vars))
+       ,@body)))
 
 ;;;###autoload
-(defmacro multiple-value-setq (vars form)
+(defmacro cl-multiple-value-setq (vars 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).
+`cl-multiple-value-setq' macro, using lists to simulate true multiple return
+values.  For compatibility, (cl-values A B C) is a synonym for (list A B C).
 
 \(fn (SYM...) FORM)"
-  (cond ((null vars) (list 'progn form nil))
-	((null (cdr vars)) (list 'setq (car vars) (list 'car form)))
+  (declare (indent 1) (debug ((&rest symbolp) form)))
+  (cond ((null vars) `(progn ,form nil))
+	((null (cdr vars)) `(setq ,(car vars) (car ,form)))
 	(t
 	 (let* ((temp (make-symbol "--cl-var--")) (n 0))
-	   (list 'let (list (list temp form))
-		 (list 'prog1 (list 'setq (pop vars) (list 'car temp))
-		       (cons 'setq (apply 'nconc
-					  (mapcar (function
-						   (lambda (v)
-						     (list v (list
-							      'nth
-							      (setq n (1+ n))
-							      temp))))
-						  vars)))))))))
+	   `(let ((,temp ,form))
+              (prog1 (setq ,(pop vars) (car ,temp))
+                (setq ,@(apply #'nconc
+                               (mapcar (lambda (v)
+                                         (list v `(nth ,(setq n (1+ n))
+                                                       ,temp)))
+                                       vars)))))))))
 
 
 ;;; Declarations.
 
 ;;;###autoload
-(defmacro locally (&rest body) (cons 'progn body))
+(defmacro cl-locally (&rest body)
+  "Equivalent to `progn'."
+  (declare (debug t))
+  (cons 'progn body))
 ;;;###autoload
-(defmacro the (type form) form)
+(defmacro cl-the (_type form)
+  "At present this ignores _TYPE and is simply equivalent to FORM."
+  (declare (indent 1) (debug (cl-type-spec form)))
+  form)
 
 (defvar cl-proclaim-history t)    ; for future compilers
 (defvar cl-declare-stack t)       ; for future compilers
@@ -1617,7 +1935,7 @@ values.  For compatibility, (values A B C) is a synonym for (list A B C).
 	((and (eq (car-safe spec) 'warn) (boundp 'byte-compile-warnings))
 	 (while (setq spec (cdr spec))
 	   (if (consp (car spec))
-	       (if (eq (cadar spec) 0)
+	       (if (eq (cl-cadar spec) 0)
                    (byte-compile-disable-warning (caar spec))
                  (byte-compile-enable-warning (caar spec)))))))
   nil)
@@ -1629,514 +1947,159 @@ values.  For compatibility, (values A B C) is a synonym for (list A B C).
   (setq cl-proclaims-deferred nil))
 
 ;;;###autoload
-(defmacro declare (&rest specs)
+(defmacro cl-declare (&rest specs)
   "Declare SPECS about the current function while compiling.
 For instance
 
-  \(declare (warn 0))
+  \(cl-declare (warn 0))
 
 will turn off byte-compile warnings in the function.
 See Info node `(cl)Declarations' for details."
-  (if (cl-compiling-file)
+  (if (cl--compiling-file)
       (while specs
 	(if (listp cl-declare-stack) (push (car specs) cl-declare-stack))
 	(cl-do-proclaim (pop specs) nil)))
   nil)
 
-
-
-;;; Generalized variables.
-
-;;;###autoload
-(defmacro define-setf-method (func args &rest 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.
-
-\(fn NAME ARGLIST BODY...)"
-  (append '(eval-when (compile load eval))
-	  (if (stringp (car body))
-	      (list (list 'put (list 'quote func) '(quote setf-documentation)
-			  (pop body))))
-	  (list (cl-transform-function-property
-		 func 'setf-method (cons args body)))))
-(defalias 'define-setf-expander 'define-setf-method)
-
-;;;###autoload
-(defmacro defsetf (func arg1 &rest args)
-  "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))
-
-\(fn NAME [FUNC | ARGLIST (STORE) BODY...])"
-  (if (and (listp arg1) (consp args))
-      (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 `(,(car p2)
-				(make-symbol ,(format "--cl-%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)))
-	`(define-setf-method ,func ,arg1
-	   ,@(and docstr (list docstr))
-	   (let*
-	       ,(nreverse
-		 (cons `(,store-temp
-			 (make-symbol ,(format "--cl-%s--" store-var)))
-		       (if restarg
-			   `((,rest-temps
-			      (mapcar (lambda (_) (make-symbol "--cl-var--"))
-				      ,restarg))
-			     ,@lets1)
-			 lets1)))
-	     (list			; 'values
-	      (,(if restarg 'list* 'list) ,@tempsr)
-	      (,(if restarg 'list* 'list) ,@largsr)
-	      (list ,store-temp)
-	      (let*
-		  ,(nreverse
-		    (cons (list store-var store-temp)
-			  lets2))
-		,@args)
-	      (,(if restarg 'list* 'list)
-	       ,@(cons (list 'quote func) tempsr))))))
-    `(defsetf ,func (&rest args) (store)
-       ,(let ((call `(cons ',arg1
-			   (append args (list store)))))
-	  (if (car args)
-	      `(list 'progn ,call store)
-	    call)))))
-
-;;; Some standard place types from Common Lisp.
-(defsetf aref aset)
-(defsetf car setcar)
-(defsetf cdr setcdr)
-(defsetf caar (x) (val) (list 'setcar (list 'car x) val))
-(defsetf cadr (x) (val) (list 'setcar (list 'cdr x) val))
-(defsetf cdar (x) (val) (list 'setcdr (list 'car x) val))
-(defsetf cddr (x) (val) (list 'setcdr (list 'cdr x) val))
-(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 '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 (&optional buf) (flag)
-  (list 'with-current-buffer buf
-	(list 'set-buffer-modified-p flag)))
-(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 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 frame-parameter set-frame-parameter t)
-(defsetf terminal-parameter set-terminal-parameter)
-(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 set-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 process-get process-put)
-(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-parameter set-window-parameter)
-(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-secondary-selection x-own-secondary-selection t)
-(defsetf x-get-selection x-own-selection t)
-
-;; This is a hack that allows (setf (eq a 7) B) to mean either
-;; (setq a 7) or (setq a nil) depending on whether B is nil or not.
-;; This is useful when you have control over the PLACE but not over
-;; the VALUE, as is the case in define-minor-mode's :variable.
-(define-setf-method eq (place val)
-  (let ((method (get-setf-method place cl-macro-environment))
-        (val-temp (make-symbol "--eq-val--"))
-        (store-temp (make-symbol "--eq-store--")))
-    (list (append (nth 0 method) (list val-temp))
-          (append (nth 1 method) (list val))
-          (list store-temp)
-          `(let ((,(car (nth 2 method))
-                  (if ,store-temp ,val-temp (not ,val-temp))))
-             ,(nth 3 method) ,store-temp)
-          `(eq ,(nth 4 method) ,val-temp))))
-
-;;; 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 (make-symbol "--cl-nthcdr-n--"))
-	(store-temp (make-symbol "--cl-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 (make-symbol "--cl-getf-tag--"))
-	(def-temp (make-symbol "--cl-getf-def--"))
-	(store-temp (make-symbol "--cl-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 (make-symbol "--cl-substring-from--"))
-	(to-temp (make-symbol "--cl-substring-to--"))
-	(store-temp (make-symbol "--cl-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.
-;;;###autoload
-(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 (make-symbol "--cl-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 (string-match-p "\\`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)))
-	  (push (cons (pop temps) (pop values)) subs)
-	(push (list (pop temps) (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.
-;;;###autoload
-(defmacro setf (&rest args)
-  "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.
 
-\(fn PLACE VAL PLACE VAL ...)"
-  (if (cdr (cdr args))
-      (let ((sets nil))
-	(while args (push (list 'setf (pop args) (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)))))
+;; `setf' is now part of core Elisp, defined in gv.el.
 
 ;;;###autoload
-(defmacro psetf (&rest args)
+(defmacro cl-psetf (&rest args)
   "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.
 
 \(fn PLACE VAL PLACE VAL ...)"
+  (declare (debug setf))
   (let ((p args) (simple t) (vars nil))
     (while p
-      (if (or (not (symbolp (car p))) (cl-expr-depends-p (nth 1 p) vars))
+      (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)))
       (push (pop p) vars)
-      (or p (error "Odd number of arguments to psetf"))
+      (or p (error "Odd number of arguments to cl-psetf"))
       (pop p))
     (if simple
-	(list 'progn (cons 'setf args) nil)
+	`(progn (setq ,@args) nil)
       (setq args (reverse args))
-      (let ((expr (list 'setf (cadr args) (car args))))
+      (let ((expr `(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)))))
-
-;;;###autoload
-(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 (make-symbol "--cl-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)))))))
+	  (setq expr `(setf ,(cadr args) (prog1 ,(car args) ,expr))))
+	`(progn ,expr nil)))))
 
 ;;;###autoload
-(defmacro remf (place tag)
+(defmacro cl-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)) (make-symbol "--cl-remf-tag--")))
-	 (val-temp (and (not (cl-simple-expr-p place))
-			(make-symbol "--cl-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)))))
+  (declare (debug (place form)))
+  (gv-letplace (tval setter) place
+    (macroexp-let2 macroexp-copyable-p ttag tag
+      `(if (eq ,ttag (car ,tval))
+           (progn ,(funcall setter `(cddr ,tval))
+                  t)
+         (cl--do-remf ,tval ,ttag)))))
 
 ;;;###autoload
-(defmacro shiftf (place &rest args)
+(defmacro cl-shiftf (place &rest args)
   "Shift left among PLACEs.
-Example: (shiftf A B C) sets A to B, B to C, and returns the old A.
+Example: (cl-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'.
 
 \(fn PLACE... VAL)"
+  (declare (debug (&rest place)))
   (cond
    ((null args) place)
-   ((symbolp place) `(prog1 ,place (setq ,place (shiftf ,@args))))
+   ((symbolp place) `(prog1 ,place (setq ,place (cl-shiftf ,@args))))
    (t
-    (let ((method (cl-setf-do-modify place 'unsafe)))
-      `(let* ,(car method)
-	 (prog1 ,(nth 2 method)
-	   ,(cl-setf-do-store (nth 1 method) `(shiftf ,@args))))))))
+    (gv-letplace (getter setter) place
+      `(prog1 ,getter
+         ,(funcall setter `(cl-shiftf ,@args)))))))
 
 ;;;###autoload
-(defmacro rotatef (&rest args)
+(defmacro cl-rotatef (&rest args)
   "Rotate left among PLACEs.
-Example: (rotatef A B C) sets A to B, B to C, and C to A.  It returns nil.
+Example: (cl-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'.
 
 \(fn PLACE...)"
+  (declare (debug (&rest place)))
   (if (not (memq nil (mapcar 'symbolp args)))
       (and (cdr args)
 	   (let ((sets nil)
 		 (first (car args)))
 	     (while (cdr args)
 	       (setq sets (nconc sets (list (pop args) (car args)))))
-	     (nconc (list 'psetf) sets (list (car args) first))))
+	     `(cl-psetf ,@sets ,(car args) ,first)))
     (let* ((places (reverse args))
 	   (temp (make-symbol "--cl-rotatef--"))
 	   (form temp))
       (while (cdr places)
-	(let ((method (cl-setf-do-modify (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)))))
+        (setq form
+              (gv-letplace (getter setter) (pop places)
+                `(prog1 ,getter ,(funcall setter form)))))
+      (gv-letplace (getter setter) (car places)
+	(macroexp-let* `((,temp ,getter))
+                       `(progn ,(funcall setter form) nil))))))
+
+;; FIXME: `letf' is unsatisfactory because it does not really "restore" the
+;; previous state.  If the getter/setter loses information, that info is
+;; not recovered.
+
+(defun cl--letf (bindings simplebinds binds body)
+  ;; It's not quite clear what the semantics of cl-letf should be.
+  ;; E.g. in (cl-letf ((PLACE1 VAL1) (PLACE2 VAL2)) BODY), while it's clear
+  ;; that the actual assignments ("bindings") should only happen after
+  ;; evaluating VAL1 and VAL2, it's not clear when the sub-expressions of
+  ;; PLACE1 and PLACE2 should be evaluated.  Should we have
+  ;;    PLACE1; VAL1; PLACE2; VAL2; bind1; bind2
+  ;; or
+  ;;    VAL1; VAL2; PLACE1; PLACE2; bind1; bind2
+  ;; or
+  ;;    VAL1; VAL2; PLACE1; bind1; PLACE2; bind2
+  ;; Common-Lisp's `psetf' does the first, so we'll do the same.
+  (if (null bindings)
+      (if (and (null binds) (null simplebinds)) (macroexp-progn body)
+        `(let* (,@(mapcar (lambda (x)
+                            (pcase-let ((`(,vold ,getter ,_setter ,_vnew) x))
+                              (list vold getter)))
+                          binds)
+                ,@simplebinds)
+           (unwind-protect
+               ,(macroexp-progn
+                 (append
+                  (delq nil
+                        (mapcar (lambda (x)
+                                  (pcase x
+                                    ;; If there's no vnew, do nothing.
+                                    (`(,_vold ,_getter ,setter ,vnew)
+                                     (funcall setter vnew))))
+                                binds))
+                  body))
+             ,@(mapcar (lambda (x)
+                         (pcase-let ((`(,vold ,_getter ,setter ,_vnew) x))
+                           (funcall setter vold)))
+                       binds))))
+    (let ((binding (car bindings)))
+      (gv-letplace (getter setter) (car binding)
+        (macroexp-let2 nil vnew (cadr binding)
+          (if (symbolp (car binding))
+              ;; Special-case for simple variables.
+              (cl--letf (cdr bindings)
+                        (cons `(,getter ,(if (cdr binding) vnew getter))
+                              simplebinds)
+                        binds body)
+            (cl--letf (cdr bindings) simplebinds
+                      (cons `(,(make-symbol "old") ,getter ,setter
+                              ,@(if (cdr binding) (list vnew)))
+                            binds)
+                      body)))))))
 
 ;;;###autoload
-(defmacro letf (bindings &rest body)
+(defmacro cl-letf (bindings &rest 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
@@ -2147,119 +2110,53 @@ As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)',
 the PLACE is not modified before executing BODY.
 
 \(fn ((PLACE VALUE) ...) BODY...)"
+  (declare (indent 1) (debug ((&rest (gate gv-place &optional form)) 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 (make-symbol "--cl-letf-save--"))
-	       (bound (and (memq (car place) '(symbol-value symbol-function))
-			   (make-symbol "--cl-letf-bound--")))
-	       (temp (and (not (cl-const-expr-p value)) (cdr bindings)
-			  (make-symbol "--cl-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))))
+      `(let ,bindings ,@body)
+    (cl--letf bindings () () body)))
 
 ;;;###autoload
-(defmacro letf* (bindings &rest body)
+(defmacro cl-letf* (bindings &rest 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.
-
-\(fn ((PLACE VALUE) ...) BODY...)"
-  (if (null bindings)
-      (cons 'progn body)
-    (setq bindings (reverse bindings))
-    (while bindings
-      (setq body (list (list* 'letf (list (pop bindings)) body))))
-    (car body)))
+Like `cl-letf' but where the bindings are performed one at a time,
+rather than all at the end (i.e. like `let*' rather than like `let')."
+  (declare (indent 1) (debug cl-letf))
+  (dolist (binding (reverse bindings))
+    (setq body (list `(cl-letf (,binding) ,@body))))
+  (macroexp-progn body))
 
 ;;;###autoload
-(defmacro callf (func place &rest args)
+(defmacro cl-callf (func place &rest 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'.
-
-\(fn FUNC PLACE ARGS...)"
-  (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))))))
+or any generalized variable allowed by `setf'."
+  (declare (indent 2) (debug (cl-function place &rest form)))
+  (gv-letplace (getter setter) place
+    (let* ((rargs (cons getter args)))
+      (funcall setter
+               (if (symbolp func) (cons func rargs)
+                 `(funcall #',func ,@rargs))))))
 
 ;;;###autoload
-(defmacro callf2 (func arg1 place &rest args)
+(defmacro cl-callf2 (func arg1 place &rest args)
   "Set PLACE to (FUNC ARG1 PLACE ARGS...).
-Like `callf', but PLACE is the second argument of FUNC, not the first.
+Like `cl-callf', but PLACE is the second argument of FUNC, not the first.
 
 \(fn FUNC ARG1 PLACE ARGS...)"
-  (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)) (make-symbol "--cl-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)))))))
-
-;;;###autoload
-(defmacro define-modify-macro (name arglist func &optional doc)
-  "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 (make-symbol "--cl-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)))))
-
+  (declare (indent 3) (debug (cl-function form place &rest form)))
+  (if (and (cl--safe-expr-p arg1) (cl--simple-expr-p place) (symbolp func))
+      `(setf ,place (,func ,arg1 ,place ,@args))
+    (macroexp-let2 nil a1 arg1
+      (gv-letplace (getter setter) place
+        (let* ((rargs (cl-list* a1 getter args)))
+          (funcall setter
+                   (if (symbolp func) (cons func rargs)
+                     `(funcall #',func ,@rargs))))))))
 
 ;;; Structures.
 
 ;;;###autoload
-(defmacro defstruct (struct &rest descs)
+(defmacro cl-defstruct (struct &rest descs)
   "Define a struct type.
 This macro defines a new data type called NAME that stores data
 in SLOTs.  It defines a `make-NAME' constructor, a `copy-NAME'
@@ -2267,8 +2164,9 @@ copier, a `NAME-p' predicate, and slot accessors named `NAME-SLOT'.
 You can use the accessors to set the corresponding slots, via `setf'.
 
 NAME may instead take the form (NAME OPTIONS...), where each
-OPTION is either a single keyword or (KEYWORD VALUE).
-See Info node `(cl)Structures' for a list of valid keywords.
+OPTION is either a single keyword or (KEYWORD VALUE) where
+KEYWORD can be one of :conc-name, :constructor, :copier, :predicate,
+:type, :named, :initial-offset, :print-function, or :include.
 
 Each SLOT may instead take the form (SLOT SLOT-OPTS...), where
 SLOT-OPTS are keyword-value pairs for that slot.  Currently, only
@@ -2276,6 +2174,26 @@ one keyword is supported, `:read-only'.  If this has a non-nil
 value, that slot cannot be set via `setf'.
 
 \(fn NAME SLOTS...)"
+  (declare (doc-string 2) (indent 1)
+           (debug
+            (&define                    ;Makes top-level form not be wrapped.
+             [&or symbolp
+                  (gate
+                   symbolp &rest
+                   (&or [":conc-name" symbolp]
+                        [":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))))
   (let* ((name (if (consp struct) (car struct) struct))
 	 (opts (cdr-safe struct))
 	 (slots nil)
@@ -2286,7 +2204,7 @@ value, that slot cannot be set via `setf'.
 	 (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))
+	 (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)))
@@ -2297,8 +2215,8 @@ value, that slot cannot be set via `setf'.
 	 (forms nil)
 	 pred-form pred-check)
     (if (stringp (car descs))
-	(push (list 'put (list 'quote name) '(quote structure-documentation)
-		       (pop descs)) forms))
+	(push `(put ',name 'structure-documentation
+                    ,(pop descs)) forms))
     (setq descs (cons '(cl-tag-slot)
 		      (mapcar (function (lambda (x) (if (consp x) x (list x))))
 			      descs)))
@@ -2340,15 +2258,13 @@ value, that slot cannot be set via `setf'.
 	      (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))
+	(setq print-func
+              `(progn (funcall #',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))))))
+				`(progn
+                                   (princ ,(format "#S(%s" name) cl-s))))))
     (if include
 	(let ((inc-type (get include 'cl-struct-type))
 	      (old-descs (get include 'cl-struct-slots)))
@@ -2367,9 +2283,9 @@ value, that slot cannot be set via `setf'.
 	  (if (cadr inc-type) (setq tag name named t))
 	  (let ((incl include))
 	    (while incl
-	      (push (list 'pushnew (list 'quote tag)
-			     (intern (format "cl-struct-%s-tags" incl)))
-		       forms)
+	      (push `(cl-pushnew ',tag
+                              ,(intern (format "cl-struct-%s-tags" incl)))
+                    forms)
 	      (setq incl (get incl 'cl-struct-include)))))
       (if type
 	  (progn
@@ -2378,25 +2294,23 @@ value, that slot cannot be set via `setf'.
 	    (if named (setq tag name)))
 	(setq type 'vector named 'true)))
     (or named (setq descs (delq (assq 'cl-tag-slot descs) descs)))
-    (push (list 'defvar tag-symbol) forms)
+    (push `(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))
+			       `(and (vectorp cl-x)
+				     (>= (length cl-x) ,(length descs))
+				     (memq (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))))))
+				 `(memq (car-safe cl-x) ,tag-symbol)
+			       `(and (consp cl-x)
+				     (memq (nth ,pos cl-x) ,tag-symbol))))))
 	  pred-check (and pred-form (> safety 0)
-			  (if (and (eq (caadr pred-form) 'vectorp)
+			  (if (and (eq (cl-caadr pred-form) 'vectorp)
 				   (= safety 1))
-			      (cons 'and (cdddr pred-form)) pred-form)))
+			      (cons 'and (cl-cdddr pred-form)) pred-form)))
     (let ((pos 0) (descp descs))
       (while descp
 	(let* ((desc (pop descp))
@@ -2404,54 +2318,60 @@ value, that slot cannot be set via `setf'.
 	  (if (memq slot '(cl-tag-slot cl-skip-slot))
 	      (progn
 		(push nil slots)
-		(push (and (eq slot 'cl-tag-slot) (list 'quote tag))
+		(push (and (eq slot 'cl-tag-slot) `',tag)
 			 defaults))
 	    (if (assq slot descp)
 		(error "Duplicate slots named %s in %s" slot name))
 	    (let ((accessor (intern (format "%s%s" conc-name slot))))
 	      (push slot slots)
 	      (push (nth 1 desc) defaults)
-	      (push (list*
-			'defsubst* accessor '(cl-x)
-			(append
-			 (and pred-check
-			      (list (list 'or pred-check
-					  `(error "%s accessing a non-%s"
-						  ',accessor ',name))))
-			 (list (if (eq type 'vector) (list 'aref 'cl-x pos)
-				 (if (= pos 0) '(car cl-x)
-				   (list 'nth pos 'cl-x)))))) forms)
+	      (push `(cl-defsubst ,accessor (cl-x)
+                       ,@(and pred-check
+			      (list `(or ,pred-check
+                                         (error "%s accessing a non-%s"
+                                                ',accessor ',name))))
+                       ,(if (eq type 'vector) `(aref cl-x ,pos)
+                          (if (= pos 0) '(car cl-x)
+                            `(nth ,pos cl-x)))) forms)
 	      (push (cons accessor t) side-eff)
-	      (push (list 'define-setf-method accessor '(cl-x)
-			     (if (cadr (memq :read-only (cddr desc)))
-                                 (list 'progn '(ignore cl-x)
-                                       `(error "%s is a read-only slot"
-					       ',accessor))
-			       ;; If cl is loaded only for compilation,
-			       ;; the call to cl-struct-setf-expander would
-			       ;; cause a warning because it may not be
-			       ;; defined at run time.  Suppress that warning.
-			       (list 'with-no-warnings
-				     (list 'cl-struct-setf-expander 'cl-x
-					   (list 'quote name) (list 'quote accessor)
-					   (and pred-check (list 'quote pred-check))
-					   pos))))
-		       forms)
+              (if (cadr (memq :read-only (cddr desc)))
+                  (push `(gv-define-expander ,accessor
+                           (lambda (_cl-do _cl-x)
+                             (error "%s is a read-only slot" ',accessor)))
+                        forms)
+                ;; For normal slots, we don't need to define a setf-expander,
+                ;; since gv-get can use the compiler macro to get the
+                ;; same result.
+                ;; (push `(gv-define-setter ,accessor (cl-val cl-x)
+                ;;          ;; If cl is loaded only for compilation,
+                ;;          ;; the call to cl--struct-setf-expander would
+                ;;          ;; cause a warning because it may not be
+                ;;          ;; defined at run time.  Suppress that warning.
+                ;;          (progn
+                ;;            (declare-function
+                ;;             cl--struct-setf-expander "cl-macs"
+                ;;             (x name accessor pred-form pos))
+                ;;            (cl--struct-setf-expander
+                ;;             cl-val cl-x ',name ',accessor
+                ;;             ,(and pred-check `',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)))))))
+			 (list `(princ ,(format " %s" slot) cl-s)
+			       `(prin1 (,accessor cl-x) cl-s)))))))
 	(setq pos (1+ pos))))
     (setq slots (nreverse slots)
 	  defaults (nreverse defaults))
     (and predicate pred-form
-	 (progn (push (list 'defsubst* predicate '(cl-x)
-			       (if (eq (car pred-form) 'and)
-				   (append pred-form '(t))
-				 (list 'and pred-form t))) forms)
+	 (progn (push `(cl-defsubst ,predicate (cl-x)
+                         ,(if (eq (car pred-form) 'and)
+                              (append pred-form '(t))
+                            `(and ,pred-form t))) forms)
 		(push (cons predicate 'error-free) side-eff)))
     (and copier
-	 (progn (push (list 'defun copier '(x) '(copy-sequence x)) forms)
+	 (progn (push `(defun ,copier (x) (copy-sequence x)) forms)
 		(push (cons copier t) side-eff)))
     (if constructor
 	(push (list constructor
@@ -2460,85 +2380,60 @@ value, that slot cannot be set via `setf'.
     (while constrs
       (let* ((name (caar constrs))
 	     (args (cadr (pop constrs)))
-	     (anames (cl-arglist-args args))
-	     (make (mapcar* (function (lambda (s d) (if (memq s anames) s d)))
+	     (anames (cl--arglist-args args))
+	     (make (cl-mapcar (function (lambda (s d) (if (memq s anames) s d)))
 			    slots defaults)))
-	(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)))
+	(push `(cl-defsubst ,name
+                 (&cl-defs '(nil ,@descs) ,@args)
+                 (,type ,@make)) forms)
+	(if (cl--safe-expr-p `(progn ,@(mapcar #'cl-second descs)))
 	    (push (cons name t) side-eff))))
     (if print-auto (nconc print-func (list '(princ ")" cl-s) t)))
-    (if print-func
-	(push `(push
-                ;; The auto-generated function does not pay attention to
-                ;; the depth argument cl-n.
-                (lambda (cl-x cl-s ,(if print-auto '_cl-n 'cl-n))
-                  (and ,pred-form ,print-func))
-                custom-print-functions)
-              forms))
-    (push (list 'setq tag-symbol (list 'list (list 'quote tag))) forms)
-    (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)))))
-
-;;;###autoload
-(defun cl-struct-setf-expander (x name accessor pred-form pos)
-  (let* ((temp (make-symbol "--cl-x--")) (store (make-symbol "--cl-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)))))
-		  (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))))
-
+    ;; Don't bother adding to cl-custom-print-functions since it's not used
+    ;; by anything anyway!
+    ;;(if print-func
+    ;;    (push `(if (boundp 'cl-custom-print-functions)
+    ;;               (push
+    ;;                ;; The auto-generated function does not pay attention to
+    ;;                ;; the depth argument cl-n.
+    ;;                (lambda (cl-x cl-s ,(if print-auto '_cl-n 'cl-n))
+    ;;                  (and ,pred-form ,print-func))
+    ;;                cl-custom-print-functions))
+    ;;          forms))
+    (push `(setq ,tag-symbol (list ',tag)) forms)
+    (push `(cl-eval-when (compile load eval)
+             (put ',name 'cl-struct-slots ',descs)
+             (put ',name 'cl-struct-type ',(list type (eq named t)))
+             (put ',name 'cl-struct-include ',include)
+             (put ',name 'cl-struct-print ,print-auto)
+             ,@(mapcar (lambda (x)
+                         `(put ',(car x) 'side-effect-free ',(cdr x)))
+                       side-eff))
+          forms)
+    `(progn ,@(nreverse (cons `',name forms)))))
 
 ;;; Types and assertions.
 
 ;;;###autoload
-(defmacro deftype (name arglist &rest body)
+(defmacro cl-deftype (name arglist &rest 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 ''('*) arglist) body))))
+The type name can then be used in `cl-typecase', `cl-check-type', etc."
+  (declare (debug cl-defmacro) (doc-string 3))
+  `(cl-eval-when (compile load eval)
+     (put ',name 'cl-deftype-handler
+          (cl-function (lambda (&cl-defs '('*) ,@arglist) ,@body)))))
 
-(defun cl-make-type-test (val type)
+(defun cl--make-type-test (val type)
   (if (symbolp type)
       (cond ((get type 'cl-deftype-handler)
-	     (cl-make-type-test val (funcall (get type 'cl-deftype-handler))))
+	     (cl--make-type-test val (funcall (get type 'cl-deftype-handler))))
 	    ((memq type '(nil t)) type)
 	    ((eq type 'null) `(null ,val))
 	    ((eq type 'atom) `(atom ,val))
-	    ((eq type 'float) `(floatp-safe ,val))
+	    ((eq type 'float) `(cl-floatp-safe ,val))
 	    ((eq type 'real) `(numberp ,val))
 	    ((eq type 'fixnum) `(integerp ,val))
-	    ;; FIXME: Should `character' accept things like ?\C-\M-a ?  -stef
+	    ;; FIXME: Should `character' accept things like ?\C-\M-a ?  --Stef
 	    ((memq type '(character string-char)) `(characterp ,val))
 	    (t
 	     (let* ((name (symbol-name type))
@@ -2546,73 +2441,77 @@ The type name can then be used in `typecase', `check-type', etc."
 	       (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)
+	   (cl--make-type-test val (apply (get (car type) 'cl-deftype-handler)
 					 (cdr type))))
 	  ((memq (car 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)))))))
+	   (delq t `(and ,(cl--make-type-test val (car type))
+			 ,(if (memq (cadr type) '(* nil)) t
+                            (if (consp (cadr type)) `(> ,val ,(cl-caadr type))
+                              `(>= ,val ,(cadr type))))
+			 ,(if (memq (cl-caddr type) '(* nil)) t
+                            (if (consp (cl-caddr type)) `(< ,val ,(cl-caaddr type))
+                              `(<= ,val ,(cl-caddr type)))))))
 	  ((memq (car type) '(and or not))
 	   (cons (car type)
-		 (mapcar (function (lambda (x) (cl-make-type-test val x)))
+		 (mapcar (function (lambda (x) (cl--make-type-test val x)))
 			 (cdr type))))
-	  ((memq (car type) '(member member*))
-	   (list 'and (list 'member* val (list 'quote (cdr type))) t))
+	  ((memq (car type) '(member cl-member))
+	   `(and (cl-member ,val ',(cdr type)) t))
 	  ((eq (car type) 'satisfies) (list (cadr type) val))
 	  (t (error "Bad type spec: %s" type)))))
 
+(defvar cl--object)
 ;;;###autoload
-(defun typep (object type)   ; See compiler macro below.
+(defun cl-typep (object 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 'object type)))
+  (let ((cl--object object)) ;; Yuck!!
+    (eval (cl--make-type-test 'cl--object type))))
 
 ;;;###autoload
-(defmacro check-type (form type &optional string)
+(defmacro cl-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))
+  (declare (debug (place cl-type-spec &optional stringp)))
+  (and (or (not (cl--compiling-file))
 	   (< cl-optimize-speed 3) (= cl-optimize-safety 3))
-       (let* ((temp (if (cl-simple-expr-p form 3)
+       (let* ((temp (if (cl--simple-expr-p form 3)
 			form (make-symbol "--cl-var--")))
-	      (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)))))
+	      (body `(or ,(cl--make-type-test temp type)
+                         (signal 'wrong-type-argument
+                                 (list ,(or string `',type)
+                                       ,temp ',form)))))
+	 (if (eq temp form) `(progn ,body nil)
+	   `(let ((,temp ,form)) ,body nil)))))
 
 ;;;###autoload
-(defmacro assert (form &optional show-args string &rest args)
+(defmacro cl-assert (form &optional show-args string &rest args)
+  ;; FIXME: This is actually not compatible with Common-Lisp's `assert'.
   "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))
+  (declare (debug (form &rest form)))
+  (and (or (not (cl--compiling-file))
 	   (< cl-optimize-speed 3) (= cl-optimize-safety 3))
        (let ((sargs (and show-args
-			 (delq nil (mapcar
-				     (lambda (x)
-				       (unless (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))))
+                         (delq nil (mapcar (lambda (x)
+                                             (unless (macroexp-const-p x)
+                                               x))
+                                           (cdr form))))))
+	 `(progn
+            (or ,form
+                ,(if string
+                     `(error ,string ,@sargs ,@args)
+                   `(signal 'cl-assertion-failed
+                            (list ',form ,@sargs))))
+            nil))))
 
 ;;; Compiler macros.
 
 ;;;###autoload
-(defmacro define-compiler-macro (func args &rest body)
+(defmacro cl-define-compiler-macro (func args &rest 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
@@ -2623,58 +2522,49 @@ 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."
+  (declare (debug cl-defmacro))
   (let ((p args) (res nil))
     (while (consp p) (push (pop p) res))
     (setq args (nconc (nreverse 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 'progn
-		    (list 'put (list 'quote func) '(quote byte-compile)
-			  '(quote cl-byte-compile-compiler-macro))
-		    ;; This is so that describe-function can locate
-		    ;; the macro definition.
-		    (list 'let
-			  (list (list
-				 'file
-				 (or buffer-file-name
-				     (and (boundp 'byte-compile-current-file)
-					  (stringp byte-compile-current-file)
-					  byte-compile-current-file))))
-			  (list 'if 'file
-				(list 'put (list 'quote func)
-				      '(quote compiler-macro-file)
-				      '(purecopy (file-name-nondirectory file)))))))))
+  `(cl-eval-when (compile load eval)
+     (put ',func 'compiler-macro
+          (cl-function (lambda ,(if (memq '&whole args) (delq '&whole args)
+                             (cons '_cl-whole-arg args))
+                         ,@body)))
+     ;; This is so that describe-function can locate
+     ;; the macro definition.
+     (let ((file ,(or buffer-file-name
+                      (and (boundp 'byte-compile-current-file)
+                           (stringp byte-compile-current-file)
+                           byte-compile-current-file))))
+       (if file (put ',func 'compiler-macro-file
+                     (purecopy (file-name-nondirectory file)))))))
 
 ;;;###autoload
-(defun compiler-macroexpand (form)
+(defun cl-compiler-macroexpand (form)
+  "Like `macroexpand', but for compiler macros.
+Expands FORM repeatedly until no further expansion is possible.
+Returns FORM unchanged if it has no compiler macro, or if it has a
+macro that returns its `&whole' argument."
   (while
       (let ((func (car-safe form)) (handler nil))
 	(while (and (symbolp func)
-		    (not (setq handler (get func 'cl-compiler-macro)))
+		    (not (setq handler (get func 'compiler-macro)))
 		    (fboundp func)
-		    (or (not (eq (car-safe (symbol-function func)) 'autoload))
-			(load (nth 1 (symbol-function func)))))
+		    (or (not (autoloadp (symbol-function func)))
+			(autoload-do-load (symbol-function func) 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)))
-
 ;; Optimize away unused block-wrappers.
 
-(defvar cl-active-block-names nil)
+(defvar cl--active-block-names nil)
 
-(define-compiler-macro cl-block-wrapper (cl-form)
+(cl-define-compiler-macro cl--block-wrapper (cl-form)
   (let* ((cl-entry (cons (nth 1 (nth 1 cl-form)) nil))
-         (cl-active-block-names (cons cl-entry cl-active-block-names))
+         (cl--active-block-names (cons cl-entry cl--active-block-names))
          (cl-body (macroexpand-all      ;Performs compiler-macro expansions.
                    (cons 'progn (cddr cl-form))
                    macroexpand-all-environment)))
@@ -2684,52 +2574,52 @@ and then returning foo."
         `(catch ,(nth 1 cl-form) ,@(cdr cl-body))
       cl-body)))
 
-(define-compiler-macro cl-block-throw (cl-tag cl-value)
-  (let ((cl-found (assq (nth 1 cl-tag) cl-active-block-names)))
+(cl-define-compiler-macro cl--block-throw (cl-tag cl-value)
+  (let ((cl-found (assq (nth 1 cl-tag) cl--active-block-names)))
     (if cl-found (setcdr cl-found t)))
   `(throw ,cl-tag ,cl-value))
 
 ;;;###autoload
-(defmacro defsubst* (name args &rest body)
+(defmacro cl-defsubst (name args &rest 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 ...).
+surrounded by (cl-block NAME ...).
 
 \(fn NAME ARGLIST [DOCSTRING] BODY...)"
-  (let* ((argns (cl-arglist-args args)) (p argns)
+  (declare (debug cl-defun) (indent 2))
+  (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)) (pop p))
-    (list 'progn
-	  (if p nil   ; give up if defaults refer to earlier args
-	    (list 'define-compiler-macro name
-		  (if (memq '&key args)
-		      (list* '&whole 'cl-whole '&cl-quote args)
-		    (cons '&cl-quote args))
-		  (list* 'cl-defsubst-expand (list 'quote argns)
-			 (list 'quote (list* 'block name body))
-                         ;; We used to pass `simple' as
-                         ;; (not (or unsafe (cl-expr-access-order pbody argns)))
-                         ;; But this is much too simplistic since it
-                         ;; does not pay attention to the argvs (and
-                         ;; cl-expr-access-order itself is also too naive).
-			 nil
-			 (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))
+	 (unsafe (not (cl--safe-expr-p pbody))))
+    (while (and p (eq (cl--expr-contains args (car p)) 1)) (pop p))
+    `(progn
+       ,(if p nil   ; give up if defaults refer to earlier args
+          `(cl-define-compiler-macro ,name
+             ,(if (memq '&key args)
+                  `(&whole cl-whole &cl-quote ,@args)
+                (cons '&cl-quote args))
+             (cl--defsubst-expand
+              ',argns '(cl-block ,name ,@body)
+              ;; We used to pass `simple' as
+              ;; (not (or unsafe (cl-expr-access-order pbody argns)))
+              ;; But this is much too simplistic since it
+              ;; does not pay attention to the argvs (and
+              ;; cl-expr-access-order itself is also too naive).
+              nil
+              ,(and (memq '&key args) 'cl-whole) ,unsafe ,@argns)))
+       (cl-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* ((substs ())
            (lets (delq nil
-                       (mapcar* (function
-                                 (lambda (argn argv)
-                                   (if (or simple (cl-const-expr-p argv))
-                                       (progn (push (cons argn argv) substs)
-                                              (and unsafe (list argn argv)))
-                                     (list argn argv))))
-                                argns argvs))))
+                       (cl-mapcar (lambda (argn argv)
+                                    (if (or simple (macroexp-const-p argv))
+                                        (progn (push (cons argn argv) substs)
+                                               (and unsafe (list argn argv)))
+                                      (list argn argv)))
+                                  argns argvs))))
       ;; FIXME: `sublis/subst' will happily substitute the symbol
       ;; `argn' in places where it's not used as a reference
       ;; to a variable.
@@ -2737,128 +2627,86 @@ surrounded by (block NAME ...).
       ;; scope, leading to name capture.
       (setq body (cond ((null substs) body)
                        ((null (cdr substs))
-                        (subst (cdar substs) (caar substs) body))
-                       (t (sublis substs body))))
-      (if lets (list 'let lets body) body))))
+                        (cl-subst (cdar substs) (caar substs) body))
+                       (t (cl-sublis substs body))))
+      (if lets `(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)
+
+(defun cl--compiler-macro-member (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)) (list 'memql a list))
+		   (cl--const-expr-val (nth 1 keys)))))
+    (cond ((eq test 'eq) `(memq ,a ,list))
+	  ((eq test 'equal) `(member ,a ,list))
+	  ((or (null keys) (eq test 'eql)) `(memql ,a ,list))
 	  (t form))))
 
-(define-compiler-macro assoc* (&whole form a list &rest keys)
+(defun cl--compiler-macro-assoc (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)))
+		   (cl--const-expr-val (nth 1 keys)))))
+    (cond ((eq test 'eq) `(assq ,a ,list))
+	  ((eq test 'equal) `(assoc ,a ,list))
+	  ((and (macroexp-const-p a) (or (null keys) (eq test 'eql)))
+	   (if (cl-floatp-safe (cl--const-expr-val a))
+	       `(assoc ,a ,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)
+;;;###autoload
+(defun cl--compiler-macro-adjoin (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))
+      `(if (cl-member ,a ,list ,@keys) ,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)
+(defun cl--compiler-macro-get (_form 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 (make-symbol "--cl-var--")))
-	    (list 'let (list (list temp val)) (subst temp val res)))))
-    form))
+      `(cl-getf (symbol-plist ,sym) ,prop ,def)
+    `(get ,sym ,prop)))
 
+(cl-define-compiler-macro cl-typep (&whole form val type)
+  (if (macroexp-const-p type)
+      (macroexp-let2 macroexp-copyable-p temp val
+        (cl--make-type-test temp (cl--const-expr-val type)))
+    form))
 
-(mapc (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
-	     `(lambda (w x)
-		,(if (symbolp (cadr y))
-		     `(list ',(cadr y)
-			    (list ',(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)
-	(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) ))
+(dolist (y '(cl-first cl-second cl-third cl-fourth
+             cl-fifth cl-sixth cl-seventh
+             cl-eighth cl-ninth cl-tenth
+             cl-rest cl-endp cl-plusp cl-minusp
+             cl-caaar cl-caadr cl-cadar
+             cl-caddr cl-cdaar cl-cdadr
+             cl-cddar cl-cdddr cl-caaaar
+             cl-caaadr cl-caadar cl-caaddr
+             cl-cadaar cl-cadadr cl-caddar
+             cl-cadddr cl-cdaaar cl-cdaadr
+             cl-cdadar cl-cdaddr cl-cddaar
+             cl-cddadr cl-cdddar cl-cddddr))
+  (put y 'side-effect-free t))
 
 ;;; Things that are inline.
-(proclaim '(inline floatp-safe acons map concatenate notany notevery
-		   cl-set-elt revappend nreconc gethash))
+(cl-proclaim '(inline cl-floatp-safe cl-acons cl-map cl-concatenate cl-notany
+               cl-notevery cl--set-elt cl-revappend cl-nreconc gethash))
 
 ;;; Things that are side-effect-free.
 (mapc (lambda (x) (put x 'side-effect-free t))
-      '(oddp evenp signum last butlast ldiff pairlis gcd lcm
-	isqrt floor* ceiling* truncate* round* mod* rem* subseq
-	list-length get* getf))
+      '(cl-oddp cl-evenp cl-signum last butlast cl-ldiff cl-pairlis cl-gcd cl-lcm
+	cl-isqrt cl-floor cl-ceiling cl-truncate cl-round cl-mod cl-rem cl-subseq
+	cl-list-length cl-get cl-getf))
 
 ;;; Things that are side-effect-and-error-free.
 (mapc (lambda (x) (put x 'side-effect-free 'error-free))
-      '(eql floatp-safe list* subst acons equalp random-state-p
-	copy-tree sublis))
+      '(eql cl-floatp-safe cl-list* cl-subst cl-acons cl-equalp cl-random-state-p
+	copy-tree cl-sublis))
 
 
 (run-hooks 'cl-macs-load-hook)
 
 ;; Local variables:
 ;; byte-compile-dynamic: t
-;; byte-compile-warnings: (not cl-functions)
 ;; generated-autoload-file: "cl-loaddefs.el"
 ;; End:
 
+(provide 'cl-macs)
+
 ;;; cl-macs.el ends here
diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el
index 1c578556835..1fa562e328a 100644
--- a/lisp/emacs-lisp/cl-seq.el
+++ b/lisp/emacs-lisp/cl-seq.el
@@ -1,6 +1,6 @@
-;;; cl-seq.el --- Common Lisp features, part 3
+;;; cl-seq.el --- Common Lisp features, part 3  -*- lexical-binding: t -*-
 
-;; Copyright (C) 1993, 2001-2011  Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001-2012  Free Software Foundation, Inc.
 
 ;; Author: Dave Gillespie <daveg@synaptics.com>
 ;; Version: 2.02
@@ -41,109 +41,101 @@
 
 ;;; Code:
 
-(require 'cl)
+(require 'cl-lib)
 
-;;; Keyword parsing.  This is special-cased here so that we can compile
-;;; this file independent from cl-macs.
+;; 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)
+(defmacro cl--parsing-keywords (kwords other-keys &rest body)
   (declare (indent 2) (debug (sexp sexp &rest form)))
-  (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))))
-
-(defmacro cl-check-key (x)
+  `(let* ,(mapcar
+           (lambda (x)
+             (let* ((var (if (consp x) (car x) x))
+                    (mem `(car (cdr (memq ',var cl-keys)))))
+               (if (eq var :test-not)
+                   (setq mem `(and ,mem (setq cl-test ,mem) t)))
+               (if (eq var :if-not)
+                   (setq mem `(and ,mem (setq cl-if ,mem) t)))
+               (list (intern
+                      (format "cl-%s" (substring (symbol-name var) 1)))
+                     (if (consp x) `(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)))
+
+(defmacro cl--check-key (x)     ;Expects `cl-key' in context of generated code.
   (declare (debug edebug-forms))
-  (list 'if 'cl-key (list 'funcall 'cl-key x) x))
+  `(if cl-key (funcall cl-key ,x) ,x))
 
-(defmacro cl-check-test-nokey (item x)
+(defmacro cl--check-test-nokey (item x) ;cl-test cl-if cl-test-not cl-if-not.
   (declare (debug edebug-forms))
-  (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)
+  `(cond
+    (cl-test (eq (not (funcall cl-test ,item ,x))
+                 cl-test-not))
+    (cl-if (eq (not (funcall cl-if ,x)) cl-if-not))
+    (t (eql ,item ,x))))
+
+(defmacro cl--check-test (item x)       ;all of the above.
   (declare (debug edebug-forms))
-  (list 'cl-check-test-nokey item (list 'cl-check-key x)))
+  `(cl--check-test-nokey ,item (cl--check-key ,x)))
 
-(defmacro cl-check-match (x y)
+(defmacro cl--check-match (x y)         ;cl-key cl-test cl-test-not
   (declare (debug edebug-forms))
-  (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))))
+  (setq x `(cl--check-key ,x) y `(cl--check-key ,y))
+  `(if cl-test
+       (eq (not (funcall cl-test ,x ,y)) cl-test-not)
+     (eql ,x ,y)))
 
 (defvar cl-test) (defvar cl-test-not)
 (defvar cl-if) (defvar cl-if-not)
 (defvar cl-key)
 
-
 ;;;###autoload
-(defun reduce (cl-func cl-seq &rest cl-keys)
+(defun cl-reduce (cl-func cl-seq &rest cl-keys)
   "Reduce two-argument FUNCTION across SEQ.
 \nKeywords supported:  :start :end :from-end :initial-value :key
 \n(fn FUNCTION SEQ [KEYWORD VALUE]...)"
-  (cl-parsing-keywords (:from-end (:start 0) :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))
+    (setq cl-seq (cl-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 (pop cl-seq)))
+			  (cl-seq (cl--check-key (pop cl-seq)))
 			  (t (funcall cl-func)))))
       (if cl-from-end
 	  (while cl-seq
-	    (setq cl-accum (funcall cl-func (cl-check-key (pop cl-seq))
+	    (setq cl-accum (funcall cl-func (cl--check-key (pop cl-seq))
 				    cl-accum)))
 	(while cl-seq
 	  (setq cl-accum (funcall cl-func cl-accum
-				  (cl-check-key (pop cl-seq))))))
+				  (cl--check-key (pop cl-seq))))))
       cl-accum)))
 
 ;;;###autoload
-(defun fill (seq item &rest cl-keys)
+(defun cl-fill (seq item &rest cl-keys)
   "Fill the elements of SEQ with ITEM.
 \nKeywords supported:  :start :end
 \n(fn SEQ ITEM [KEYWORD VALUE]...)"
-  (cl-parsing-keywords ((:start 0) :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)))
@@ -159,19 +151,19 @@
     seq))
 
 ;;;###autoload
-(defun replace (cl-seq1 cl-seq2 &rest cl-keys)
+(defun cl-replace (cl-seq1 cl-seq2 &rest cl-keys)
   "Replace the elements of SEQ1 with the elements of SEQ2.
 SEQ1 is destructively modified, then returned.
 \nKeywords supported:  :start1 :end1 :start2 :end2
 \n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
-  (cl-parsing-keywords ((:start1 0) :end1 (:start2 0) :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)
+		(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))
@@ -202,21 +194,21 @@ SEQ1 is destructively modified, then returned.
     cl-seq1))
 
 ;;;###autoload
-(defun remove* (cl-item cl-seq &rest cl-keys)
+(defun cl-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.
 \nKeywords supported:  :test :test-not :key :count :start :end :from-end
 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
-  (cl-parsing-keywords (:test :test-not :key :if :if-not :count :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)))
+	  (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)
+		(let ((cl-res (apply 'cl-delete cl-item (append cl-seq nil)
 				     (append (if cl-from-end
 						 (list :end (1+ cl-i))
 					       (list :start cl-i))
@@ -227,20 +219,20 @@ to avoid corrupting the original 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))
+			(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))))
+			  (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)
+		  (nconc (cl-ldiff cl-seq cl-p)
 			 (if (= cl-count 1) (cdr cl-p)
 			   (and (cdr cl-p)
-				(apply 'delete* cl-item
+				(apply 'cl-delete cl-item
 				       (copy-sequence (cdr cl-p))
 				       :start 0 :end (1- cl-end)
 				       :count (1- cl-count) cl-keys))))
@@ -248,30 +240,30 @@ to avoid corrupting the original SEQ.
 	  cl-seq)))))
 
 ;;;###autoload
-(defun remove-if (cl-pred cl-list &rest cl-keys)
+(defun cl-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.
 \nKeywords supported:  :key :count :start :end :from-end
 \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
-  (apply 'remove* nil cl-list :if cl-pred cl-keys))
+  (apply 'cl-remove nil cl-list :if cl-pred cl-keys))
 
 ;;;###autoload
-(defun remove-if-not (cl-pred cl-list &rest cl-keys)
+(defun cl-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.
 \nKeywords supported:  :key :count :start :end :from-end
 \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
-  (apply 'remove* nil cl-list :if-not cl-pred cl-keys))
+  (apply 'cl-remove nil cl-list :if-not cl-pred cl-keys))
 
 ;;;###autoload
-(defun delete* (cl-item cl-seq &rest cl-keys)
+(defun cl-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.
 \nKeywords supported:  :test :test-not :key :count :start :end :from-end
 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
-  (cl-parsing-keywords (:test :test-not :key :if :if-not :count :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
@@ -279,8 +271,8 @@ This is a destructive function; it reuses the storage of SEQ whenever possible.
 	  (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)))
+			    (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)))))
@@ -291,7 +283,7 @@ This is a destructive function; it reuses the storage of SEQ whenever possible.
 		(progn
 		  (while (and cl-seq
 			      (> cl-end 0)
-			      (cl-check-test cl-item (car cl-seq))
+			      (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)))
@@ -299,7 +291,7 @@ This is a destructive function; it reuses the storage of SEQ whenever possible.
 	    (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)))
+		    (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)
@@ -307,49 +299,49 @@ This is a destructive function; it reuses the storage of SEQ whenever possible.
 		      (setq cl-p (cdr cl-p)))
 		    (setq cl-end (1- cl-end)))))
 	    cl-seq)
-	(apply 'remove* cl-item cl-seq cl-keys)))))
+	(apply 'cl-remove cl-item cl-seq cl-keys)))))
 
 ;;;###autoload
-(defun delete-if (cl-pred cl-list &rest cl-keys)
+(defun cl-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.
 \nKeywords supported:  :key :count :start :end :from-end
 \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
-  (apply 'delete* nil cl-list :if cl-pred cl-keys))
+  (apply 'cl-delete nil cl-list :if cl-pred cl-keys))
 
 ;;;###autoload
-(defun delete-if-not (cl-pred cl-list &rest cl-keys)
+(defun cl-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.
 \nKeywords supported:  :key :count :start :end :from-end
 \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
-  (apply 'delete* nil cl-list :if-not cl-pred cl-keys))
+  (apply 'cl-delete nil cl-list :if-not cl-pred cl-keys))
 
 ;;;###autoload
-(defun remove-duplicates (cl-seq &rest cl-keys)
+(defun cl-remove-duplicates (cl-seq &rest cl-keys)
   "Return a copy of SEQ with all duplicate elements removed.
 \nKeywords supported:  :test :test-not :key :start :end :from-end
 \n(fn SEQ [KEYWORD VALUE]...)"
-  (cl-delete-duplicates cl-seq cl-keys t))
+  (cl--delete-duplicates cl-seq cl-keys t))
 
 ;;;###autoload
-(defun delete-duplicates (cl-seq &rest cl-keys)
+(defun cl-delete-duplicates (cl-seq &rest cl-keys)
   "Remove all duplicate elements from SEQ (destructively).
 \nKeywords supported:  :test :test-not :key :start :end :from-end
 \n(fn SEQ [KEYWORD VALUE]...)"
-  (cl-delete-duplicates cl-seq cl-keys nil))
+  (cl--delete-duplicates cl-seq cl-keys nil))
 
-(defun cl-delete-duplicates (cl-seq cl-keys cl-copy)
+(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)
+      (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)))
+		(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)))
@@ -360,14 +352,14 @@ This is a destructive function; it reuses the storage of SEQ whenever possible.
 	      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)))
+		      (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))
+	      (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)
@@ -376,63 +368,63 @@ This is a destructive function; it reuses the storage of SEQ whenever possible.
 		(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)))
+    (let ((cl-res (cl--delete-duplicates (append cl-seq nil) cl-keys nil)))
       (if (stringp cl-seq) (concat cl-res) (vconcat cl-res)))))
 
 ;;;###autoload
-(defun substitute (cl-new cl-old cl-seq &rest cl-keys)
+(defun cl-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.
 \nKeywords supported:  :test :test-not :key :count :start :end :from-end
 \n(fn NEW OLD SEQ [KEYWORD VALUE]...)"
-  (cl-parsing-keywords (:test :test-not :key :if :if-not :count
+  (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)))
+      (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)
+	      (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
+	  (apply 'cl-nsubstitute cl-new cl-old cl-seq :count cl-count
 		 :start cl-i cl-keys))))))
 
 ;;;###autoload
-(defun substitute-if (cl-new cl-pred cl-list &rest cl-keys)
+(defun cl-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.
 \nKeywords supported:  :key :count :start :end :from-end
 \n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
-  (apply 'substitute cl-new nil cl-list :if cl-pred cl-keys))
+  (apply 'cl-substitute cl-new nil cl-list :if cl-pred cl-keys))
 
 ;;;###autoload
-(defun substitute-if-not (cl-new cl-pred cl-list &rest cl-keys)
+(defun cl-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.
 \nKeywords supported:  :key :count :start :end :from-end
 \n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
-  (apply 'substitute cl-new nil cl-list :if-not cl-pred cl-keys))
+  (apply 'cl-substitute cl-new nil cl-list :if-not cl-pred cl-keys))
 
 ;;;###autoload
-(defun nsubstitute (cl-new cl-old cl-seq &rest cl-keys)
+(defun cl-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.
 \nKeywords supported:  :test :test-not :key :count :start :end :from-end
 \n(fn NEW OLD SEQ [KEYWORD VALUE]...)"
-  (cl-parsing-keywords (:test :test-not :key :if :if-not :count
+  (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))
+		(if (cl--check-test cl-old (car cl-p))
 		    (progn
 		      (setcar cl-p cl-new)
 		      (setq cl-count (1- cl-count))))
@@ -441,12 +433,12 @@ This is a destructive function; it reuses the storage of SEQ whenever possible.
 	  (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))
+		(if (cl--check-test cl-old (elt cl-seq cl-end))
 		    (progn
-		      (cl-set-elt cl-seq cl-end cl-new)
+		      (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))
+	      (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))))
@@ -454,63 +446,63 @@ This is a destructive function; it reuses the storage of SEQ whenever possible.
     cl-seq))
 
 ;;;###autoload
-(defun nsubstitute-if (cl-new cl-pred cl-list &rest cl-keys)
+(defun cl-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.
 \nKeywords supported:  :key :count :start :end :from-end
 \n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
-  (apply 'nsubstitute cl-new nil cl-list :if cl-pred cl-keys))
+  (apply 'cl-nsubstitute cl-new nil cl-list :if cl-pred cl-keys))
 
 ;;;###autoload
-(defun nsubstitute-if-not (cl-new cl-pred cl-list &rest cl-keys)
+(defun cl-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.
 \nKeywords supported:  :key :count :start :end :from-end
 \n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
-  (apply 'nsubstitute cl-new nil cl-list :if-not cl-pred cl-keys))
+  (apply 'cl-nsubstitute cl-new nil cl-list :if-not cl-pred cl-keys))
 
 ;;;###autoload
-(defun find (cl-item cl-seq &rest cl-keys)
+(defun cl-find (cl-item cl-seq &rest cl-keys)
   "Find the first occurrence of ITEM in SEQ.
 Return the matching ITEM, or nil if not found.
 \nKeywords supported:  :test :test-not :key :start :end :from-end
 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
-  (let ((cl-pos (apply 'position cl-item cl-seq cl-keys)))
+  (let ((cl-pos (apply 'cl-position cl-item cl-seq cl-keys)))
     (and cl-pos (elt cl-seq cl-pos))))
 
 ;;;###autoload
-(defun find-if (cl-pred cl-list &rest cl-keys)
+(defun cl-find-if (cl-pred cl-list &rest cl-keys)
   "Find the first item satisfying PREDICATE in SEQ.
 Return the matching item, or nil if not found.
 \nKeywords supported:  :key :start :end :from-end
 \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
-  (apply 'find nil cl-list :if cl-pred cl-keys))
+  (apply 'cl-find nil cl-list :if cl-pred cl-keys))
 
 ;;;###autoload
-(defun find-if-not (cl-pred cl-list &rest cl-keys)
+(defun cl-find-if-not (cl-pred cl-list &rest cl-keys)
   "Find the first item not satisfying PREDICATE in SEQ.
 Return the matching item, or nil if not found.
 \nKeywords supported:  :key :start :end :from-end
 \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
-  (apply 'find nil cl-list :if-not cl-pred cl-keys))
+  (apply 'cl-find nil cl-list :if-not cl-pred cl-keys))
 
 ;;;###autoload
-(defun position (cl-item cl-seq &rest cl-keys)
+(defun cl-position (cl-item cl-seq &rest cl-keys)
   "Find the first occurrence of ITEM in SEQ.
 Return the index of the matching item, or nil if not found.
 \nKeywords supported:  :test :test-not :key :start :end :from-end
 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
-  (cl-parsing-keywords (:test :test-not :key :if :if-not
+  (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)))
+    (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)
+(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))
+	    (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))
@@ -518,73 +510,73 @@ Return the index of the matching item, or nil if not found.
     (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)))))
+		      (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))))
+		  (not (cl--check-test cl-item (aref cl-seq cl-start))))
 	(setq cl-start (1+ cl-start)))
       (and (< cl-start cl-end) cl-start))))
 
 ;;;###autoload
-(defun position-if (cl-pred cl-list &rest cl-keys)
+(defun cl-position-if (cl-pred cl-list &rest cl-keys)
   "Find the first item satisfying PREDICATE in SEQ.
 Return the index of the matching item, or nil if not found.
 \nKeywords supported:  :key :start :end :from-end
 \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
-  (apply 'position nil cl-list :if cl-pred cl-keys))
+  (apply 'cl-position nil cl-list :if cl-pred cl-keys))
 
 ;;;###autoload
-(defun position-if-not (cl-pred cl-list &rest cl-keys)
+(defun cl-position-if-not (cl-pred cl-list &rest cl-keys)
   "Find the first item not satisfying PREDICATE in SEQ.
 Return the index of the matching item, or nil if not found.
 \nKeywords supported:  :key :start :end :from-end
 \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
-  (apply 'position nil cl-list :if-not cl-pred cl-keys))
+  (apply 'cl-position nil cl-list :if-not cl-pred cl-keys))
 
 ;;;###autoload
-(defun count (cl-item cl-seq &rest cl-keys)
+(defun cl-count (cl-item cl-seq &rest cl-keys)
   "Count the number of occurrences of ITEM in SEQ.
 \nKeywords supported:  :test :test-not :key :start :end
 \n(fn ITEM SEQ [KEYWORD VALUE]...)"
-  (cl-parsing-keywords (:test :test-not :key :if :if-not (:start 0) :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) (pop cl-seq) (aref cl-seq cl-start)))
-	(if (cl-check-test cl-item cl-x) (setq cl-count (1+ cl-count)))
+	(if (cl--check-test cl-item cl-x) (setq cl-count (1+ cl-count)))
 	(setq cl-start (1+ cl-start)))
       cl-count)))
 
 ;;;###autoload
-(defun count-if (cl-pred cl-list &rest cl-keys)
+(defun cl-count-if (cl-pred cl-list &rest cl-keys)
   "Count the number of items satisfying PREDICATE in SEQ.
 \nKeywords supported:  :key :start :end
 \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
-  (apply 'count nil cl-list :if cl-pred cl-keys))
+  (apply 'cl-count nil cl-list :if cl-pred cl-keys))
 
 ;;;###autoload
-(defun count-if-not (cl-pred cl-list &rest cl-keys)
+(defun cl-count-if-not (cl-pred cl-list &rest cl-keys)
   "Count the number of items not satisfying PREDICATE in SEQ.
 \nKeywords supported:  :key :start :end
 \n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
-  (apply 'count nil cl-list :if-not cl-pred cl-keys))
+  (apply 'cl-count nil cl-list :if-not cl-pred cl-keys))
 
 ;;;###autoload
-(defun mismatch (cl-seq1 cl-seq2 &rest cl-keys)
+(defun cl-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 shorter sequence.
 \nKeywords supported:  :test :test-not :key :start1 :end1 :start2 :end2 :from-end
 \n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
-  (cl-parsing-keywords (:test :test-not :key :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))
+		      (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))
@@ -592,7 +584,7 @@ other, the return value indicates the end of the shorter sequence.
       (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)
+		    (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))))
@@ -602,26 +594,26 @@ other, the return value indicates the end of the shorter sequence.
 	     cl-start1)))))
 
 ;;;###autoload
-(defun search (cl-seq1 cl-seq2 &rest cl-keys)
+(defun cl-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.
 \nKeywords supported:  :test :test-not :key :start1 :end1 :start2 :end2 :from-end
 \n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
-  (cl-parsing-keywords (:test :test-not :key :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-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
+		    (setq cl-pos (cl--position cl-first cl-seq2
+                                               cl-start2 cl-end2 cl-from-end))
+		    (apply 'cl-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))
@@ -629,14 +621,14 @@ return nil if there are no matches.
 	(and (< cl-start2 cl-end2) cl-pos)))))
 
 ;;;###autoload
-(defun sort* (cl-seq cl-pred &rest cl-keys)
+(defun cl-sort (cl-seq cl-pred &rest cl-keys)
   "Sort the argument SEQ according to PREDICATE.
 This is a destructive function; it reuses the storage of SEQ if possible.
 \nKeywords supported:  :key
 \n(fn SEQ PREDICATE [KEYWORD VALUE]...)"
   (if (nlistp cl-seq)
-      (replace cl-seq (apply 'sort* (append cl-seq nil) cl-pred cl-keys))
-    (cl-parsing-keywords (:key) ()
+      (cl-replace cl-seq (apply 'cl-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)
@@ -644,15 +636,15 @@ This is a destructive function; it reuses the storage of SEQ if possible.
 					  (funcall cl-key cl-y)))))))))
 
 ;;;###autoload
-(defun stable-sort (cl-seq cl-pred &rest cl-keys)
+(defun cl-stable-sort (cl-seq cl-pred &rest cl-keys)
   "Sort the argument SEQ stably according to PREDICATE.
 This is a destructive function; it reuses the storage of SEQ if possible.
 \nKeywords supported:  :key
 \n(fn SEQ PREDICATE [KEYWORD VALUE]...)"
-  (apply 'sort* cl-seq cl-pred cl-keys))
+  (apply 'cl-sort cl-seq cl-pred cl-keys))
 
 ;;;###autoload
-(defun merge (cl-type cl-seq1 cl-seq2 cl-pred &rest cl-keys)
+(defun cl-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 PREDICATE is a `less-than' predicate on the elements.
@@ -660,115 +652,117 @@ sequences, and PREDICATE is a `less-than' predicate on the elements.
 \n(fn TYPE SEQ1 SEQ2 PREDICATE [KEYWORD VALUE]...)"
   (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) ()
+  (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)))
+	(if (funcall cl-pred (cl--check-key (car cl-seq2))
+		     (cl--check-key (car cl-seq1)))
 	    (push (pop cl-seq2) cl-res)
 	  (push (pop cl-seq1) cl-res)))
-      (coerce (nconc (nreverse cl-res) cl-seq1 cl-seq2) cl-type))))
+      (cl-coerce (nconc (nreverse cl-res) cl-seq1 cl-seq2) cl-type))))
 
-;;; See compiler macro in cl-macs.el
 ;;;###autoload
-(defun member* (cl-item cl-list &rest cl-keys)
+(defun cl-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.
 \nKeywords supported:  :test :test-not :key
 \n(fn ITEM LIST [KEYWORD VALUE]...)"
+  (declare (compiler-macro cl--compiler-macro-member))
   (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))))
+      (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))))
+(autoload 'cl--compiler-macro-member "cl-macs")
 
 ;;;###autoload
-(defun member-if (cl-pred cl-list &rest cl-keys)
+(defun cl-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.
 \nKeywords supported:  :key
 \n(fn PREDICATE LIST [KEYWORD VALUE]...)"
-  (apply 'member* nil cl-list :if cl-pred cl-keys))
+  (apply 'cl-member nil cl-list :if cl-pred cl-keys))
 
 ;;;###autoload
-(defun member-if-not (cl-pred cl-list &rest cl-keys)
+(defun cl-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.
 \nKeywords supported:  :key
 \n(fn PREDICATE LIST [KEYWORD VALUE]...)"
-  (apply 'member* nil cl-list :if-not cl-pred cl-keys))
+  (apply 'cl-member nil cl-list :if-not cl-pred cl-keys))
 
 ;;;###autoload
-(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))
+(defun cl--adjoin (cl-item cl-list &rest cl-keys)
+  (if (cl--parsing-keywords (:key) t
+	(apply 'cl-member (cl--check-key cl-item) cl-list cl-keys))
       cl-list
     (cons cl-item cl-list)))
 
-;;; See compiler macro in cl-macs.el
 ;;;###autoload
-(defun assoc* (cl-item cl-alist &rest cl-keys)
+(defun cl-assoc (cl-item cl-alist &rest cl-keys)
   "Find the first item whose car matches ITEM in LIST.
 \nKeywords supported:  :test :test-not :key
 \n(fn ITEM LIST [KEYWORD VALUE]...)"
+  (declare (compiler-macro cl--compiler-macro-assoc))
   (if cl-keys
-      (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
+      (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))))))
+			(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))))
+(autoload 'cl--compiler-macro-assoc "cl-macs")
 
 ;;;###autoload
-(defun assoc-if (cl-pred cl-list &rest cl-keys)
+(defun cl-assoc-if (cl-pred cl-list &rest cl-keys)
   "Find the first item whose car satisfies PREDICATE in LIST.
 \nKeywords supported:  :key
 \n(fn PREDICATE LIST [KEYWORD VALUE]...)"
-  (apply 'assoc* nil cl-list :if cl-pred cl-keys))
+  (apply 'cl-assoc nil cl-list :if cl-pred cl-keys))
 
 ;;;###autoload
-(defun assoc-if-not (cl-pred cl-list &rest cl-keys)
+(defun cl-assoc-if-not (cl-pred cl-list &rest cl-keys)
   "Find the first item whose car does not satisfy PREDICATE in LIST.
 \nKeywords supported:  :key
 \n(fn PREDICATE LIST [KEYWORD VALUE]...)"
-  (apply 'assoc* nil cl-list :if-not cl-pred cl-keys))
+  (apply 'cl-assoc nil cl-list :if-not cl-pred cl-keys))
 
 ;;;###autoload
-(defun rassoc* (cl-item cl-alist &rest cl-keys)
+(defun cl-rassoc (cl-item cl-alist &rest cl-keys)
   "Find the first item whose cdr matches ITEM in LIST.
 \nKeywords supported:  :test :test-not :key
 \n(fn ITEM LIST [KEYWORD VALUE]...)"
   (if (or cl-keys (numberp cl-item))
-      (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
+      (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))))))
+			(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)))
 
 ;;;###autoload
-(defun rassoc-if (cl-pred cl-list &rest cl-keys)
+(defun cl-rassoc-if (cl-pred cl-list &rest cl-keys)
   "Find the first item whose cdr satisfies PREDICATE in LIST.
 \nKeywords supported:  :key
 \n(fn PREDICATE LIST [KEYWORD VALUE]...)"
-  (apply 'rassoc* nil cl-list :if cl-pred cl-keys))
+  (apply 'cl-rassoc nil cl-list :if cl-pred cl-keys))
 
 ;;;###autoload
-(defun rassoc-if-not (cl-pred cl-list &rest cl-keys)
+(defun cl-rassoc-if-not (cl-pred cl-list &rest cl-keys)
   "Find the first item whose cdr does not satisfy PREDICATE in LIST.
 \nKeywords supported:  :key
 \n(fn PREDICATE LIST [KEYWORD VALUE]...)"
-  (apply 'rassoc* nil cl-list :if-not cl-pred cl-keys))
+  (apply 'cl-rassoc nil cl-list :if-not cl-pred cl-keys))
 
 ;;;###autoload
-(defun union (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-union (cl-list1 cl-list2 &rest cl-keys)
   "Combine LIST1 and LIST2 using a set-union operation.
 The resulting 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
@@ -782,14 +776,14 @@ to avoid corrupting the original LIST1 and 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))
+	       (setq cl-list1 (apply 'cl-adjoin (car cl-list2) cl-list1 cl-keys))
 	     (or (memq (car cl-list2) cl-list1)
 		 (push (car cl-list2) cl-list1)))
 	   (pop cl-list2))
 	 cl-list1)))
 
 ;;;###autoload
-(defun nunion (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-nunion (cl-list1 cl-list2 &rest cl-keys)
   "Combine LIST1 and LIST2 using a set-union operation.
 The resulting list contains all items that appear in either LIST1 or LIST2.
 This is a destructive function; it reuses the storage of LIST1 and LIST2
@@ -797,10 +791,10 @@ whenever possible.
 \nKeywords supported:  :test :test-not :key
 \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
   (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
-	(t (apply 'union cl-list1 cl-list2 cl-keys))))
+	(t (apply 'cl-union cl-list1 cl-list2 cl-keys))))
 
 ;;;###autoload
-(defun intersection (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-intersection (cl-list1 cl-list2 &rest cl-keys)
   "Combine LIST1 and LIST2 using a set-intersection operation.
 The resulting 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
@@ -809,13 +803,13 @@ to avoid corrupting the original LIST1 and LIST2.
 \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
   (and cl-list1 cl-list2
        (if (equal cl-list1 cl-list2) cl-list1
-	 (cl-parsing-keywords (:key) (:test :test-not)
+	 (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))
+		       (apply 'cl-member (cl--check-key (car cl-list2))
 			      cl-list1 cl-keys)
 		     (memq (car cl-list2) cl-list1))
 		   (push (car cl-list2) cl-res))
@@ -823,17 +817,17 @@ to avoid corrupting the original LIST1 and LIST2.
 	     cl-res)))))
 
 ;;;###autoload
-(defun nintersection (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-nintersection (cl-list1 cl-list2 &rest cl-keys)
   "Combine LIST1 and LIST2 using a set-intersection operation.
 The resulting 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.
 \nKeywords supported:  :test :test-not :key
 \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
-  (and cl-list1 cl-list2 (apply 'intersection cl-list1 cl-list2 cl-keys)))
+  (and cl-list1 cl-list2 (apply 'cl-intersection cl-list1 cl-list2 cl-keys)))
 
 ;;;###autoload
-(defun set-difference (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-set-difference (cl-list1 cl-list2 &rest cl-keys)
   "Combine LIST1 and LIST2 using a set-difference operation.
 The resulting 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
@@ -841,11 +835,11 @@ to avoid corrupting the original LIST1 and LIST2.
 \nKeywords supported:  :test :test-not :key
 \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
   (if (or (null cl-list1) (null cl-list2)) cl-list1
-    (cl-parsing-keywords (:key) (:test :test-not)
+    (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))
+		  (apply 'cl-member (cl--check-key (car cl-list1))
 			 cl-list2 cl-keys)
 		(memq (car cl-list1) cl-list2))
 	      (push (car cl-list1) cl-res))
@@ -853,7 +847,7 @@ to avoid corrupting the original LIST1 and LIST2.
 	cl-res))))
 
 ;;;###autoload
-(defun nset-difference (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-nset-difference (cl-list1 cl-list2 &rest cl-keys)
   "Combine LIST1 and LIST2 using a set-difference operation.
 The resulting list contains all items that appear in LIST1 but not LIST2.
 This is a destructive function; it reuses the storage of LIST1 and LIST2
@@ -861,10 +855,10 @@ whenever possible.
 \nKeywords supported:  :test :test-not :key
 \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
   (if (or (null cl-list1) (null cl-list2)) cl-list1
-    (apply 'set-difference cl-list1 cl-list2 cl-keys)))
+    (apply 'cl-set-difference cl-list1 cl-list2 cl-keys)))
 
 ;;;###autoload
-(defun set-exclusive-or (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-set-exclusive-or (cl-list1 cl-list2 &rest cl-keys)
   "Combine LIST1 and LIST2 using a set-exclusive-or operation.
 The resulting list contains all items appearing in exactly one of LIST1, LIST2.
 This is a non-destructive function; it makes a copy of the data if necessary
@@ -873,11 +867,11 @@ to avoid corrupting the original LIST1 and LIST2.
 \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
   (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)))))
+	(t (append (apply 'cl-set-difference cl-list1 cl-list2 cl-keys)
+		   (apply 'cl-set-difference cl-list2 cl-list1 cl-keys)))))
 
 ;;;###autoload
-(defun nset-exclusive-or (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-nset-exclusive-or (cl-list1 cl-list2 &rest cl-keys)
   "Combine LIST1 and LIST2 using a set-exclusive-or operation.
 The resulting list contains all items appearing in exactly one of LIST1, LIST2.
 This is a destructive function; it reuses the storage of LIST1 and LIST2
@@ -886,134 +880,136 @@ whenever possible.
 \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
   (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)))))
+	(t (nconc (apply 'cl-nset-difference cl-list1 cl-list2 cl-keys)
+		  (apply 'cl-nset-difference cl-list2 cl-list1 cl-keys)))))
 
 ;;;###autoload
-(defun subsetp (cl-list1 cl-list2 &rest cl-keys)
+(defun cl-subsetp (cl-list1 cl-list2 &rest cl-keys)
   "Return true if LIST1 is a subset of LIST2.
 I.e., if every element of LIST1 also appears in LIST2.
 \nKeywords supported:  :test :test-not :key
 \n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
   (cond ((null cl-list1) t) ((null cl-list2) nil)
 	((equal cl-list1 cl-list2) t)
-	(t (cl-parsing-keywords (:key) (:test :test-not)
+	(t (cl--parsing-keywords (:key) (:test :test-not)
 	     (while (and cl-list1
-			 (apply 'member* (cl-check-key (car cl-list1))
+			 (apply 'cl-member (cl--check-key (car cl-list1))
 				cl-list2 cl-keys))
 	       (pop cl-list1))
 	     (null cl-list1)))))
 
 ;;;###autoload
-(defun subst-if (cl-new cl-pred cl-tree &rest cl-keys)
+(defun cl-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.
 \nKeywords supported:  :key
 \n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
-  (apply 'sublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys))
+  (apply 'cl-sublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys))
 
 ;;;###autoload
-(defun subst-if-not (cl-new cl-pred cl-tree &rest cl-keys)
+(defun cl-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.
 \nKeywords supported:  :key
 \n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
-  (apply 'sublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys))
+  (apply 'cl-sublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys))
 
 ;;;###autoload
-(defun nsubst (cl-new cl-old cl-tree &rest cl-keys)
+(defun cl-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').
 \nKeywords supported:  :test :test-not :key
 \n(fn NEW OLD TREE [KEYWORD VALUE]...)"
-  (apply 'nsublis (list (cons cl-old cl-new)) cl-tree cl-keys))
+  (apply 'cl-nsublis (list (cons cl-old cl-new)) cl-tree cl-keys))
 
 ;;;###autoload
-(defun nsubst-if (cl-new cl-pred cl-tree &rest cl-keys)
+(defun cl-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').
 \nKeywords supported:  :key
 \n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
-  (apply 'nsublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys))
+  (apply 'cl-nsublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys))
 
 ;;;###autoload
-(defun nsubst-if-not (cl-new cl-pred cl-tree &rest cl-keys)
+(defun cl-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').
 \nKeywords supported:  :key
 \n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
-  (apply 'nsublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys))
+  (apply 'cl-nsublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys))
+
+(defvar cl--alist)
 
 ;;;###autoload
-(defun sublis (cl-alist cl-tree &rest cl-keys)
+(defun cl-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.
 \nKeywords supported:  :test :test-not :key
 \n(fn ALIST TREE [KEYWORD VALUE]...)"
-  (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
-    (cl-sublis-rec cl-tree)))
+  (cl--parsing-keywords (:test :test-not :key :if :if-not) ()
+    (let ((cl--alist cl-alist))
+      (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)))
+(defun cl--sublis-rec (cl-tree)   ;Uses cl--alist cl-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))))
+	  (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))))
 
 ;;;###autoload
-(defun nsublis (cl-alist cl-tree &rest cl-keys)
+(defun cl-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'.
 \nKeywords supported:  :test :test-not :key
 \n(fn ALIST TREE [KEYWORD VALUE]...)"
-  (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
-    (let ((cl-hold (list cl-tree)))
-      (cl-nsublis-rec cl-hold)
+  (cl--parsing-keywords (:test :test-not :key :if :if-not) ()
+    (let ((cl-hold (list cl-tree))
+          (cl--alist cl-alist))
+      (cl--nsublis-rec cl-hold)
       (car cl-hold))))
 
-(defun cl-nsublis-rec (cl-tree)   ; uses cl-alist/temp/p/key/test*/if*
+(defun cl--nsublis-rec (cl-tree)   ;Uses cl--alist cl-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)))
+    (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)))
+	(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))))))
 
 ;;;###autoload
-(defun tree-equal (cl-x cl-y &rest cl-keys)
+(defun cl-tree-equal (cl-x cl-y &rest cl-keys)
   "Return t if trees TREE1 and TREE2 have `eql' leaves.
 Atoms are compared by `eql'; cons cells are compared recursively.
 \nKeywords supported:  :test :test-not :key
 \n(fn TREE1 TREE2 [KEYWORD VALUE]...)"
-  (cl-parsing-keywords (:test :test-not :key) ()
-    (cl-tree-equal-rec cl-x cl-y)))
+  (cl--parsing-keywords (:test :test-not :key) ()
+    (cl--tree-equal-rec cl-x cl-y)))
 
-(defun cl-tree-equal-rec (cl-x cl-y)
+(defun cl--tree-equal-rec (cl-x cl-y)   ;Uses cl-key/test*.
   (while (and (consp cl-x) (consp cl-y)
-	      (cl-tree-equal-rec (car cl-x) (car 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)))
+  (and (not (consp cl-x)) (not (consp cl-y)) (cl--check-match cl-x cl-y)))
 
 
 (run-hooks 'cl-seq-load-hook)
 
 ;; Local variables:
 ;; byte-compile-dynamic: t
-;; byte-compile-warnings: (not cl-functions)
 ;; generated-autoload-file: "cl-loaddefs.el"
 ;; End:
 
diff --git a/lisp/emacs-lisp/cl-specs.el b/lisp/emacs-lisp/cl-specs.el
deleted file mode 100644
index 3556b6c1ecf..00000000000
--- a/lisp/emacs-lisp/cl-specs.el
+++ /dev/null
@@ -1,471 +0,0 @@
-;;; cl-specs.el --- Edebug specs for cl.el -*- no-byte-compile: t -*-
-
-;; Copyright (C) 1993, 2001-2011 Free Software Foundation, Inc.
-;; Author: Daniel LaLiberte <liberte@holonexus.org>
-;; Keywords: lisp, tools, maint
-;; Package: emacs
-
-;; LCD Archive Entry:
-;; cl-specs.el|Daniel LaLiberte|liberte@holonexus.org
-;; |Edebug specs for cl.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 3 of the License, 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.  If not, see <http://www.gnu.org/licenses/>.
-
-;;; 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.
-
-;;; Code:
-
-(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 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 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 def-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))	; different for CL
-(def-edebug-spec pushnew
-  (form place &rest
-	&or [[&or ":test" ":test-not" ":key"] function-form]
-	[keywordp form]))
-(def-edebug-spec pop (place))		; different for CL
-
-(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-keys"]]
-    [&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-keys"]]
-    [&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-keys"]]
-    [&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*" function*)
-       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" symbolp]
-		      [":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 valid 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))
-
-;;; cl-specs.el ends here
diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el
index 16eb31c1209..40d12358b17 100644
--- a/lisp/emacs-lisp/cl.el
+++ b/lisp/emacs-lisp/cl.el
@@ -1,9 +1,8 @@
-;;; cl.el --- Common Lisp extensions for Emacs
+;;; cl.el --- Compatibility aliases for the old CL library.  -*- lexical-binding: t -*-
 
-;; Copyright (C) 1993, 2001-2011  Free Software Foundation, Inc.
+;; Copyright (C) 2012  Free Software Foundation, Inc.
 
-;; Author: Dave Gillespie <daveg@synaptics.com>
-;; Version: 2.02
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
 ;; Keywords: extensions
 
 ;; This file is part of GNU Emacs.
@@ -23,699 +22,717 @@
 
 ;;; 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.
-;;
-;; 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.
-
+;; This is a compatibility file which provides the old names provided by CL
+;; before we cleaned up its namespace usage.
 
 ;;; Code:
 
-(defvar cl-optimize-speed 1)
-(defvar cl-optimize-safety 1)
-
-
-;;;###autoload
-(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.")
-
-(defun cl-unload-function ()
-  "Stop unloading of the Common Lisp extensions."
-  (message "Cannot unload the feature `cl'")
-  ;; stop standard unloading!
-  t)
-
-;;; Generalized variables.
-;; These macros are defined here so that they
-;; can safely be used in .emacs files.
-
-(defmacro incf (place &optional 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)
-  "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))))
-
-;; Autoloaded, but we haven't loaded cl-loaddefs yet.
-(declare-function cl-do-pop "cl-macs" (place))
-
-(defmacro 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)
-  "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.
-\nKeywords supported:  :test :test-not :key
-\n(fn X PLACE [KEYWORD VALUE]...)"
-  (if (symbolp place)
-      (if (null keys)
- 	  `(let ((x ,x))
-	     (if (memql x ,place)
-                 ;; This symbol may later on expand to actual code which then
-                 ;; trigger warnings like "value unused" since pushnew's return
-                 ;; value is rarely used.  It should not matter that other
-                 ;; warnings may be silenced, since `place' is used earlier and
-                 ;; should have triggered them already.
-                 (with-no-warnings ,place)
-               (setq ,place (cons x ,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)))
-
-(defsubst 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 (length 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.
-
-(defun cl-map-extents (&rest cl-args)
-  (apply 'cl-map-overlays 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.
-
-(defsubst values (&rest values)
-  "Return multiple values, Common Lisp style.
-The arguments of `values' are the values
-that the containing function should return."
-  values)
-
-(defsubst values-list (list)
-  "Return multiple values, Common Lisp style, taken from a list.
-LIST specifies the list of values
-that the containing function should return."
-  list)
-
-(defsubst multiple-value-list (expression)
-  "Return a list of the multiple values produced by EXPRESSION.
-This handles multiple values in Common Lisp style, but it does not
-work right when EXPRESSION calls an ordinary Emacs Lisp function
-that returns just one value."
-  expression)
-
-(defsubst multiple-value-apply (function expression)
-  "Evaluate EXPRESSION to get multiple values and apply FUNCTION to them.
-This handles multiple values in Common Lisp style, but it does not work
-right when EXPRESSION calls an ordinary Emacs Lisp function that returns just
-one value."
-  (apply function expression))
-
-(defalias 'multiple-value-call 'apply
-  "Apply FUNCTION to ARGUMENTS, taking multiple values into account.
-This implementation only handles the case where there is only one argument.")
-
-(defsubst nth-value (n expression)
-  "Evaluate EXPRESSION to get multiple values and return the Nth one.
-This handles multiple values in Common Lisp style, but it does not work
-right when EXPRESSION calls an ordinary Emacs Lisp function that returns just
-one value."
-  (nth n expression))
-
-;;; Macros.
-
-(defvar cl-macro-environment)
-(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 specifies an environment of macro
-definitions to shadow the loaded ones for use in file byte-compilation.
-\n(fn FORM &optional ENVIRONMENT)"
-  (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 'byte-compile--outbuffer)
-           (bufferp (symbol-value 'byte-compile--outbuffer))
-	   (equal (buffer-name (symbol-value 'byte-compile--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 (object)
-  "Return t if OBJECT is a floating point number.
-On Emacs versions that lack floating-point support, this function
-always returns nil."
-  (and (numberp object) (not (integerp object))))
-
-(defun plusp (number)
-  "Return t if NUMBER is positive."
-  (> number 0))
-
-(defun minusp (number)
-  "Return t if NUMBER is negative."
-  (< number 0))
-
-(defun oddp (integer)
-  "Return t if INTEGER is odd."
-  (eq (logand integer 1) 1))
-
-(defun evenp (integer)
-  "Return t if INTEGER is even."
-  (eq (logand integer 1) 0))
-
-(defvar *random-state* (vector 'cl-random-state-tag -1 30 (cl-random-time)))
-
-(defconst most-positive-float nil
-  "The largest value that a Lisp float can hold.
-If your system supports infinities, this is the largest finite value.
-For IEEE machines, this is approximately 1.79e+308.
-Call `cl-float-limits' to set this.")
-
-(defconst most-negative-float nil
-  "The largest negative value that a Lisp float can hold.
-This is simply -`most-positive-float'.
-Call `cl-float-limits' to set this.")
-
-(defconst least-positive-float nil
-  "The smallest value greater than zero that a Lisp float can hold.
-For IEEE machines, it is about 4.94e-324 if denormals are supported,
-or 2.22e-308 if they are not.
-Call `cl-float-limits' to set this.")
-
-(defconst least-negative-float nil
-  "The smallest value less than zero that a Lisp float can hold.
-This is simply -`least-positive-float'.
-Call `cl-float-limits' to set this.")
-
-(defconst least-positive-normalized-float nil
-  "The smallest normalized Lisp float greater than zero.
-This is the smallest value for which IEEE denormalization does not lose
-precision.  For IEEE machines, this value is about 2.22e-308.
-For machines that do not support the concept of denormalization
-and gradual underflow, this constant equals `least-positive-float'.
-Call `cl-float-limits' to set this.")
-
-(defconst least-negative-normalized-float nil
-  "The smallest normalized Lisp float less than zero.
-This is simply -`least-positive-normalized-float'.
-Call `cl-float-limits' to set this.")
-
-(defconst float-epsilon nil
-  "The smallest positive float that adds to 1.0 to give a distinct value.
-Adding a number less than this to 1.0 returns 1.0 due to roundoff.
-For IEEE machines, epsilon is about 2.22e-16.
-Call `cl-float-limits' to set this.")
-
-(defconst float-negative-epsilon nil
-  "The smallest positive float that subtracts from 1.0 to give a distinct value.
-For IEEE machines, it is about 1.11e-16.
-Call `cl-float-limits' to set this.")
-
-
-;;; Sequence functions.
-
-(defalias 'copy-seq 'copy-sequence)
-
-(declare-function cl-mapcar-many "cl-extra" (cl-func cl-seqs))
-
-(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.
-\n(fn FUNCTION SEQ...)"
-  (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)))
-
-(defalias 'svref 'aref)
-
-;;; List functions.
-
-(defalias 'first 'car)
-(defalias 'second 'cadr)
-(defalias 'rest 'cdr)
-(defalias 'endp 'null)
-
-(defun third (x)
-  "Return the third element of the list X."
-  (car (cdr (cdr x))))
-
-(defun fourth (x)
-  "Return the fourth element of the list X."
-  (nth 3 x))
-
-(defun fifth (x)
-  "Return the fifth element of the list X."
-  (nth 4 x))
-
-(defun sixth (x)
-  "Return the sixth element of the list X."
-  (nth 5 x))
-
-(defun seventh (x)
-  "Return the seventh element of the list X."
-  (nth 6 x))
-
-(defun eighth (x)
-  "Return the eighth element of the list X."
-  (nth 7 x))
-
-(defun ninth (x)
-  "Return the ninth element of the list X."
-  (nth 8 x))
-
-(defun tenth (x)
-  "Return the tenth element of the list X."
-  (nth 9 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 list* (arg &rest rest)   ; See compiler macro in cl-macs.el
-  "Return a new list with specified ARGs as elements, consed 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)))'.
-\n(fn ARG...)"
-  (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 LIST, which may be a dotted list.
-The elements of 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)))
+(require 'cl-lib)
+(require 'macroexp)
+
+;; (defun cl--rename ()
+;;   (let ((vdefs ())
+;;         (fdefs ())
+;;         (case-fold-search nil)
+;;         (files '("cl.el" "cl-macs.el" "cl-seq.el" "cl-extra.el")))
+;;     (dolist (file files)
+;;       (with-current-buffer (find-file-noselect file)
+;;         (goto-char (point-min))
+;;         (while (re-search-forward
+;;                 "^(\\(def[^ \t\n]*\\) +'?\\(\\(\\sw\\|\\s_\\)+\\)" nil t)
+;;           (let ((name (match-string-no-properties 2))
+;;                 (type (match-string-no-properties 1)))
+;;             (unless (string-match-p "\\`cl-" name)
+;;               (cond
+;;                ((member type '("defvar" "defconst"))
+;;                 (unless (member name vdefs) (push name vdefs)))
+;;                ((member type '("defun" "defsubst" "defalias" "defmacro"))
+;;                 (unless (member name fdefs) (push name fdefs)))
+;;                ((member type '("def-edebug-spec" "defsetf" "define-setf-method"
+;;                                "define-compiler-macro"))
+;;                 nil)
+;;                (t (error "Unknown type %S" type))))))))
+;;     (let ((re (concat "\\_<" (regexp-opt (append vdefs fdefs)) "\\_>"))
+;;           (conflicts ()))
+;;       (dolist (file files)
+;;         (with-current-buffer (find-file-noselect file)
+;;           (goto-char (point-min))
+;;           (while (re-search-forward re nil t)
+;;             (replace-match "cl-\\&"))
+;;           (save-buffer))))
+;;     (with-current-buffer (find-file-noselect "cl-rename.el")
+;;       (dolist (def vdefs)
+;;         (insert (format "(defvaralias '%s 'cl-%s)\n" def def)))
+;;       (dolist (def fdefs)
+;;         (insert (format "(defalias '%s 'cl-%s)\n" def def)))
+;;       (save-buffer))))
+
+;; (defun cl--unrename ()
+;;   ;; Taken from "Naming Conventions" node of the doc.
+;;   (let* ((names '(defun* defsubst* defmacro* function* member*
+;;                          assoc* rassoc* get* remove* delete*
+;;                          mapcar* sort* floor* ceiling* truncate*
+;;                          round* mod* rem* random*))
+;;          (files '("cl.el" "cl-lib.el" "cl-macs.el" "cl-seq.el" "cl-extra.el"))
+;;          (re (concat "\\_<cl-" (regexp-opt (mapcar #'symbol-name names))
+;;                      "\\_>")))
+;;     (dolist (file files)
+;;       (with-current-buffer (find-file-noselect file)
+;;         (goto-char (point-min))
+;;         (while (re-search-forward re nil t)
+;;           (delete-region (1- (point)) (point)))
+;;         (save-buffer)))))
+
+;;; Aliases to cl-lib's features.
+
+(dolist (var '(
+               ;; loop-result-var
+               ;; loop-result
+               ;; loop-initially
+               ;; loop-finally
+               ;; loop-bindings
+               ;; loop-args
+               ;; bind-inits
+               ;; bind-block
+               ;; lambda-list-keywords
+               float-negative-epsilon
+               float-epsilon
+               least-negative-normalized-float
+               least-positive-normalized-float
+               least-negative-float
+               least-positive-float
+               most-negative-float
+               most-positive-float
+               ;; custom-print-functions
+               ))
+  (defvaralias var (intern (format "cl-%s" var))))
+
+(dolist (fun '(
+               (get* . cl-get)
+               (random* . cl-random)
+               (rem* . cl-rem)
+               (mod* . cl-mod)
+               (round* . cl-round)
+               (truncate* . cl-truncate)
+               (ceiling* . cl-ceiling)
+               (floor* . cl-floor)
+               (rassoc* . cl-rassoc)
+               (assoc* . cl-assoc)
+               (member* . cl-member)
+               (delete* . cl-delete)
+               (remove* . cl-remove)
+               (defsubst* . cl-defsubst)
+               (sort* . cl-sort)
+               (function* . cl-function)
+               (defmacro* . cl-defmacro)
+               (defun* . cl-defun)
+               (mapcar* . cl-mapcar)
+
+               remprop
+               getf
+               tailp
+               list-length
+               nreconc
+               revappend
+               concatenate
+               subseq
+               random-state-p
+               make-random-state
+               signum
+               isqrt
+               lcm
+               gcd
+               notevery
+               notany
+               every
+               some
+               mapcon
+               mapcan
+               mapl
+               maplist
+               map
+               equalp
+               coerce
+               tree-equal
+               nsublis
+               sublis
+               nsubst-if-not
+               nsubst-if
+               nsubst
+               subst-if-not
+               subst-if
+               subsetp
+               nset-exclusive-or
+               set-exclusive-or
+               nset-difference
+               set-difference
+               nintersection
+               intersection
+               nunion
+               union
+               rassoc-if-not
+               rassoc-if
+               assoc-if-not
+               assoc-if
+               member-if-not
+               member-if
+               merge
+               stable-sort
+               search
+               mismatch
+               count-if-not
+               count-if
+               count
+               position-if-not
+               position-if
+               position
+               find-if-not
+               find-if
+               find
+               nsubstitute-if-not
+               nsubstitute-if
+               nsubstitute
+               substitute-if-not
+               substitute-if
+               substitute
+               delete-duplicates
+               remove-duplicates
+               delete-if-not
+               delete-if
+               remove-if-not
+               remove-if
+               replace
+               fill
+               reduce
+               compiler-macroexpand
+               define-compiler-macro
+               assert
+               check-type
+               typep
+               deftype
+               defstruct
+               callf2
+               callf
+               letf*
+               ;; letf
+               rotatef
+               shiftf
+               remf
+               psetf
+               (define-setf-method . define-setf-expander)
+               the
+               locally
+               multiple-value-setq
+               multiple-value-bind
+               symbol-macrolet
+               macrolet
+               progv
+               psetq
+               do-all-symbols
+               do-symbols
+               do*
+               do
+               loop
+               return-from
+               return
+               block
+               etypecase
+               typecase
+               ecase
+               case
+               load-time-value
+               eval-when
+               destructuring-bind
+               gentemp
+               gensym
+               pairlis
+               acons
+               subst
+               adjoin
+               copy-list
+               ldiff
+               list*
+               cddddr
+               cdddar
+               cddadr
+               cddaar
+               cdaddr
+               cdadar
+               cdaadr
+               cdaaar
+               cadddr
+               caddar
+               cadadr
+               cadaar
+               caaddr
+               caadar
+               caaadr
+               caaaar
+               cdddr
+               cddar
+               cdadr
+               cdaar
+               caddr
+               cadar
+               caadr
+               caaar
+               tenth
+               ninth
+               eighth
+               seventh
+               sixth
+               fifth
+               fourth
+               third
+               endp
+               rest
+               second
+               first
+               svref
+               copy-seq
+               evenp
+               oddp
+               minusp
+               plusp
+               floatp-safe
+               declaim
+               proclaim
+               nth-value
+               multiple-value-call
+               multiple-value-apply
+               multiple-value-list
+               values-list
+               values
+               pushnew
+               decf
+               incf
+               ))
+  (let ((new (if (consp fun) (prog1 (cdr fun) (setq fun (car fun)))
+               (intern (format "cl-%s" fun)))))
+    (defalias fun new)))
+
+(defun cl--wrap-in-nil-block (fun &rest args)
+  `(cl-block nil ,(apply fun args)))
+(advice-add 'dolist :around #'cl--wrap-in-nil-block)
+(advice-add 'dotimes :around #'cl--wrap-in-nil-block)
+
+(defun cl--pass-args-to-cl-declare (&rest specs)
+   (macroexpand `(cl-declare ,@specs)))
+(advice-add 'declare :after #'cl--pass-args-to-cl-declare)
+
+;;; Features provided a bit differently in Elisp.
+
+;; First, the old lexical-let is now better served by `lexical-binding', tho
+;; it's not 100% compatible.
+
+(defvar cl-closure-vars nil)
+(defvar cl--function-convert-cache nil)
+
+(defun cl--function-convert (f)
+  "Special macro-expander for special cases of (function F).
+The two cases that are handled are:
+- closure-conversion of lambda expressions for `lexical-let'.
+- renaming of F when it's a function defined via `cl-labels' or `labels'."
+  (require 'cl-macs)
+  (declare-function cl--expr-contains-any "cl-macs" (x y))
+  (cond
+   ;; ¡¡Big Ugly Hack!! We can't use a compiler-macro because those are checked
+   ;; *after* handling `function', but we want to stop macroexpansion from
+   ;; being applied infinitely, so we use a cache to return the exact `form'
+   ;; being expanded even though we don't receive it.
+   ((eq f (car cl--function-convert-cache)) (cdr cl--function-convert-cache))
+   ((eq (car-safe f) 'lambda)
+    (let ((body (mapcar (lambda (f)
+                          (macroexpand-all f macroexpand-all-environment))
+                        (cddr f))))
+      (if (and cl-closure-vars
+               (cl--expr-contains-any body cl-closure-vars))
+          (let* ((new (mapcar 'cl-gensym cl-closure-vars))
+                 (sub (cl-pairlis cl-closure-vars new)) (decls nil))
+            (while (or (stringp (car body))
+                       (eq (car-safe (car body)) 'interactive))
+              (push (list 'quote (pop body)) decls))
+            (put (car (last cl-closure-vars)) 'used t)
+            `(list 'lambda '(&rest --cl-rest--)
+                   ,@(cl-sublis sub (nreverse decls))
+                   (list 'apply
+                         (list 'quote
+                               #'(lambda ,(append new (cadr f))
+                                   ,@(cl-sublis sub body)))
+                         ,@(nconc (mapcar (lambda (x) `(list 'quote ,x))
+                                          cl-closure-vars)
+                                  '((quote --cl-rest--))))))
+        (let* ((newf `(lambda ,(cadr f) ,@body))
+               (res `(function ,newf)))
+          (setq cl--function-convert-cache (cons newf res))
+          res))))
+   (t
+    (let ((found (assq f macroexpand-all-environment)))
+      (if (and found (ignore-errors
+                       (eq (cadr (cl-caddr found)) 'cl-labels-args)))
+          (cadr (cl-caddr (cl-cadddr found)))
+        (let ((res `(function ,f)))
+          (setq cl--function-convert-cache (cons f res))
+          res))))))
+
+(defmacro lexical-let (bindings &rest body)
+  "Like `let', but lexically scoped.
+The main visible difference is that lambdas inside BODY will create
+lexical closures as in Common Lisp.
+\n(fn BINDINGS BODY)"
+  (declare (indent 1) (debug let))
+  (let* ((cl-closure-vars cl-closure-vars)
+	 (vars (mapcar (function
+			(lambda (x)
+			  (or (consp x) (setq x (list x)))
+			  (push (make-symbol (format "--cl-%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
+	  (macroexpand-all
+           `(cl-symbol-macrolet
+                ,(mapcar (lambda (x)
+                           `(,(car x) (symbol-value ,(cl-caddr x))))
+                         vars)
+              ,@body)
+	   (cons (cons 'function #'cl--function-convert)
+                 macroexpand-all-environment))))
+    (if (not (get (car (last cl-closure-vars)) 'used))
+        ;; Turn (let ((foo (cl-gensym)))
+        ;;        (set foo <val>) ...(symbol-value foo)...)
+        ;; into (let ((foo <val>)) ...(symbol-value 'foo)...).
+        ;; This is good because it's more efficient but it only works with
+        ;; dynamic scoping, since with lexical scoping we'd need
+        ;; (let ((foo <val>)) ...foo...).
+	`(progn
+           ,@(mapcar (lambda (x) `(defvar ,(cl-caddr x))) vars)
+           (let ,(mapcar (lambda (x) (list (cl-caddr x) (cadr x))) vars)
+           ,(cl-sublis (mapcar (lambda (x)
+                              (cons (cl-caddr x)
+                                    `',(cl-caddr x)))
+                            vars)
+                    ebody)))
+      `(let ,(mapcar (lambda (x)
+                       (list (cl-caddr x)
+                             `(make-symbol ,(format "--%s--" (car x)))))
+                     vars)
+         (setf ,@(apply #'append
+                        (mapcar (lambda (x)
+                                  (list `(symbol-value ,(cl-caddr x)) (cadr x)))
+                                vars)))
+         ,ebody))))
+
+(defmacro lexical-let* (bindings &rest body)
+  "Like `let*', but lexically scoped.
+The main visible difference is that lambdas inside BODY, and in
+successive bindings within BINDINGS, will create lexical closures
+as in Common Lisp.  This is similar to the behavior of `let*' in
+Common Lisp.
+\n(fn BINDINGS BODY)"
+  (declare (indent 1) (debug let))
+  (if (null bindings) (cons 'progn body)
+    (setq bindings (reverse bindings))
+    (while bindings
+      (setq body (list `(lexical-let (,(pop bindings)) ,@body))))
+    (car body)))
+
+;; This should really have some way to shadow 'byte-compile properties, etc.
+(defmacro flet (bindings &rest body)
+  "Make temporary overriding function definitions.
+This is an analogue of a dynamically scoped `let' that operates on the function
+cell of FUNCs rather than their value cell.
+If you want the Common-Lisp style of `flet', you should use `cl-flet'.
+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).
+
+\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
+  (declare (indent 1) (debug cl-flet)
+           (obsolete "use either `cl-flet' or `cl-letf'."  "24.3"))
+  `(letf ,(mapcar
+           (lambda (x)
+             (if (or (and (fboundp (car x))
+                          (eq (car-safe (symbol-function (car x))) 'macro))
+                     (cdr (assq (car x) macroexpand-all-environment)))
+                 (error "Use `labels', not `flet', to rebind macro names"))
+             (let ((func `(cl-function
+                           (lambda ,(cadr x)
+                             (cl-block ,(car x) ,@(cddr x))))))
+               (when (cl--compiling-file)
+                 ;; Bug#411.  It would be nice to fix this.
+                 (and (get (car x) 'byte-compile)
+                      (error "Byte-compiling a redefinition of `%s' \
+will not work - use `labels' instead" (symbol-name (car x))))
+                 ;; FIXME This affects the rest of the file, when it
+                 ;; should be restricted to the flet body.
+                 (and (boundp 'byte-compile-function-environment)
+                      (push (cons (car x) (eval func))
+                            byte-compile-function-environment)))
+               (list `(symbol-function ',(car x)) func)))
+           bindings)
+     ,@body))
+
+(defmacro labels (bindings &rest body)
+  "Make temporary function bindings.
+Like `cl-labels' except that the lexical scoping is handled via `lexical-let'
+rather than relying on `lexical-binding'."
+  (declare (indent 1) (debug cl-flet) (obsolete cl-labels "24.3"))
+  (let ((vars nil) (sets nil) (newenv macroexpand-all-environment))
+    (dolist (binding bindings)
+      ;; It's important that (not (eq (symbol-name var1) (symbol-name var2)))
+      ;; because these var's *names* get added to the macro-environment.
+      (let ((var (make-symbol (format "--cl-%s--" (car binding)))))
+	(push var vars)
+	(push `(cl-function (lambda . ,(cdr binding))) sets)
+	(push var sets)
+	(push (cons (car binding)
+                    `(lambda (&rest cl-labels-args)
+                       (cl-list* 'funcall ',var
+                                 cl-labels-args)))
+              newenv)))
+    (macroexpand-all `(lexical-let ,vars (setq ,@sets) ,@body) newenv)))
+
+;; Generalized variables are provided by gv.el, but some details are
+;; not 100% compatible: not worth the trouble to add them to cl-lib.el, but we
+;; still need to support old users of cl.el.
+
+(defmacro cl--symbol-function (symbol)
+  "Like `symbol-function' but return `cl--unbound' if not bound."
+  ;; (declare (gv-setter (lambda (store)
+  ;;                       `(if (eq ,store 'cl--unbound)
+  ;;                            (fmakunbound ,symbol) (fset ,symbol ,store)))))
+  `(if (fboundp ,symbol) (symbol-function ,symbol) 'cl--unbound))
+(gv-define-setter cl--symbol-function (store symbol)
+  `(if (eq ,store 'cl--unbound) (fmakunbound ,symbol) (fset ,symbol ,store)))
+
+(defmacro letf (bindings &rest body)
+  "Dynamically scoped let-style bindings for places.
+For more details, see `cl-letf'.  This macro behaves like that one
+in almost every respect (apart from details that relate to some
+deprecated usage of `symbol-function' in place forms)."  ; bug#12760
+  (declare (indent 1) (debug cl-letf))
+  ;; Like cl-letf, but with special handling of symbol-function.
+  `(cl-letf ,(mapcar (lambda (x) (if (eq (car-safe (car x)) 'symbol-function)
+                                `((cl--symbol-function ,@(cdar x)) ,@(cdr x))
+                              x))
+                     bindings)
+            ,@body))
+
+(defun cl--gv-adapt (cl-gv do)
+  ;; This function is used by all .elc files that use define-setf-expander and
+  ;; were compiled with Emacs>=24.3.
+  (let ((vars (nth 0 cl-gv))
+        (vals (nth 1 cl-gv))
+        (binds ())
+        (substs ()))
+    ;; Use cl-sublis as was done in cl-setf-do-modify.
+    (while vars
+      (if (macroexp-copyable-p (car vals))
+          (push (cons (pop vars) (pop vals)) substs)
+        (push (list (pop vars) (pop vals)) binds)))
+    (macroexp-let*
+     binds
+     (funcall do (cl-sublis substs (nth 4 cl-gv))
+              ;; We'd like to do something like
+              ;; (lambda ,(nth 2 cl-gv) ,(nth 3 cl-gv)).
+              (lambda (exp)
+                (macroexp-let2 macroexp-copyable-p v exp
+                  (cl-sublis (cons (cons (car (nth 2 cl-gv)) v)
+                                   substs)
+                             (nth 3 cl-gv))))))))
+
+(defmacro define-setf-expander (name arglist &rest 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 `gv-define-expander', and `gv-define-setter' for better and
+simpler ways to define setf-methods."
+  (declare (debug
+            (&define name cl-lambda-list cl-declarations-or-string def-body)))
+  `(progn
+     ,@(if (stringp (car body))
+           (list `(put ',name 'setf-documentation ,(pop body))))
+     (gv-define-expander ,name
+       (cl-function
+        (lambda (do ,@arglist)
+          (cl--gv-adapt (progn ,@body) do))))))
+
+(defmacro defsetf (name arg1 &rest args)
+  "Define a `setf' method.
+This macro is an easy-to-use substitute for `define-setf-expander'
+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).  For example:
+
+  (defsetf aref aset)
+
+You can replace this form with `gv-define-simple-setter'.
+
+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.
+For example:
+
+  (defsetf nth (n x) (v) `(setcar (nthcdr ,n ,x) ,v))
+
+You can replace this form with `gv-define-setter'.
+
+\(fn NAME [FUNC | ARGLIST (STORE) BODY...])"
+  (declare (debug
+            (&define name
+                     [&or [symbolp &optional stringp]
+                          [cl-lambda-list (symbolp)]]
+                     cl-declarations-or-string def-body)))
+  (if (and (listp arg1) (consp args))
+      ;; Like `gv-define-setter' but with `cl-function'.
+      `(gv-define-expander ,name
+         (lambda (do &rest args)
+           (gv--defsetter ',name
+                          (cl-function
+                           (lambda (,@(car args) ,@arg1) ,@(cdr args)))
+			  do args)))
+    `(gv-define-simple-setter ,name ,arg1 ,(car args))))
+
+;; FIXME: CL used to provide a setf method for `apply', but I haven't been able
+;; to find a case where it worked.  The code below tries to handle it as well.
+;; (defun cl--setf-apply (form last-witness last)
+;;   (cond
+;;    ((not (consp form)) form)
+;;    ((eq (ignore-errors (car (last form))) last-witness)
+;;     `(apply #',(car form) ,@(butlast (cdr form)) ,last))
+;;    ((and (memq (car form) '(let let*))
+;;          (rassoc (list last-witness) (cadr form)))
+;;     (let ((rebind (rassoc (list last-witness) (cadr form))))
+;;     `(,(car form) ,(remq rebind (cadr form))
+;;       ,@(mapcar (lambda (form) (cl--setf-apply form (car rebind) last))
+;;                 (cddr form)))))
+;;    (t (mapcar (lambda (form) (cl--setf-apply form last-witness last)) form))))
+;; (gv-define-setter apply (val fun &rest args)
+;;   (pcase fun (`#',(and (pred symbolp) f) (setq fun f))
+;;          (_ (error "First arg to apply in setf is not #'SYM: %S" fun)))
+;;   (let* ((butlast (butlast args))
+;;          (last (car (last args)))
+;;          (last-witness (make-symbol "--cl-tailarg--"))
+;;          (setter (macroexpand `(setf (,fun ,@butlast ,last-witness) ,val)
+;;                               macroexpand-all-environment)))
+;;     (cl--setf-apply setter last-witness last)))
+
+
+;; FIXME: CL used to provide get-setf-method, which was used by some
+;; setf-expanders, but now that we use gv.el, it is a lot more difficult
+;; and in general impossible to provide get-setf-method.  Hopefully, it
+;; won't be needed.  If needed, we'll have to do something nasty along the
+;; lines of
+;; (defun get-setf-method (place &optional env)
+;;   (let* ((witness (list 'cl-gsm))
+;;          (expansion (gv-letplace (getter setter) place
+;;                      `(,witness ,getter ,(funcall setter witness)))))
+;;     ...find "let prefix" of expansion, extract getter and setter from
+;;     ...the rest, and build the 5-tuple))
+(make-obsolete 'get-setf-method 'gv-letplace "24.3")
+
+(defmacro define-modify-macro (name arglist func &optional doc)
+  "Define a `setf'-like modify macro.
+If NAME is called, it combines its PLACE argument with the other
+arguments from ARGLIST using FUNC.  For example:
+
+  (define-modify-macro incf (&optional (n 1)) +)
+
+You can replace this macro with `gv-letplace'."
+  (declare (debug
+            (&define name cl-lambda-list ;; should exclude &key
+                     symbolp &optional stringp)))
+  (if (memq '&key arglist)
+      (error "&key not allowed in define-modify-macro"))
+  (let ((place (make-symbol "--cl-place--")))
+    `(cl-defmacro ,name (,place ,@arglist)
+       ,doc
+       (,(if (memq '&rest arglist) #'cl-list* #'list)
+        #'cl-callf ',func ,place
+        ,@(cl--arglist-args arglist)))))
+
+;;; Additional compatibility code.
+;; For names that were clean but really aren't needed any more.
+
+(define-obsolete-function-alias 'cl-macroexpand 'macroexpand "24.3")
+(define-obsolete-variable-alias 'cl-macro-environment
+  'macroexpand-all-environment "24.3")
+(define-obsolete-function-alias 'cl-macroexpand-all 'macroexpand-all "24.3")
+
+;;; Hash tables.
+;; This is just kept for compatibility with code byte-compiled by Emacs-20.
+
+;; No idea if this might still be needed.
+(defun cl-not-hash-table (x &optional y &rest _z)
+  (declare (obsolete nil "24.3"))
+  (signal 'wrong-type-argument (list 'cl-hash-table-p (or y x))))
+
+(defvar cl-builtin-gethash (symbol-function 'gethash))
+(make-obsolete-variable 'cl-builtin-gethash nil "24.3")
+(defvar cl-builtin-remhash (symbol-function 'remhash))
+(make-obsolete-variable 'cl-builtin-remhash nil "24.3")
+(defvar cl-builtin-clrhash (symbol-function 'clrhash))
+(make-obsolete-variable 'cl-builtin-clrhash nil "24.3")
+(defvar cl-builtin-maphash (symbol-function 'maphash))
+
+(make-obsolete-variable 'cl-builtin-maphash nil "24.3")
+(define-obsolete-function-alias 'cl-map-keymap 'map-keymap "24.3")
+(define-obsolete-function-alias 'cl-copy-tree 'copy-tree "24.3")
+(define-obsolete-function-alias 'cl-gethash 'gethash "24.3")
+(define-obsolete-function-alias 'cl-puthash 'puthash "24.3")
+(define-obsolete-function-alias 'cl-remhash 'remhash "24.3")
+(define-obsolete-function-alias 'cl-clrhash 'clrhash "24.3")
+(define-obsolete-function-alias 'cl-maphash 'maphash "24.3")
+(define-obsolete-function-alias 'cl-make-hash-table 'make-hash-table "24.3")
+(define-obsolete-function-alias 'cl-hash-table-p 'hash-table-p "24.3")
+(define-obsolete-function-alias 'cl-hash-table-count 'hash-table-count "24.3")
+
+(define-obsolete-function-alias 'cl-map-keymap-recursively
+  'cl--map-keymap-recursively "24.3")
+(define-obsolete-function-alias 'cl-map-intervals 'cl--map-intervals "24.3")
+(define-obsolete-function-alias 'cl-map-extents 'cl--map-overlays "24.3")
 
 (defun cl-maclisp-member (item list)
+  (declare (obsolete member "24.3"))
   (while (and list (not (equal item (car list)))) (setq list (cdr list)))
   list)
 
-(defalias 'cl-member 'memq)   ; for compatibility with old CL package
-
-;; Autoloaded, but we have not loaded cl-loaddefs yet.
-(declare-function floor* "cl-extra" (x &optional y))
-(declare-function ceiling* "cl-extra" (x &optional y))
-(declare-function truncate* "cl-extra" (x &optional y))
-(declare-function round* "cl-extra" (x &optional y))
-(declare-function mod* "cl-extra" (x y))
-
-(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.
-\nKeywords supported:  :test :test-not :key
-\n(fn ITEM LIST [KEYWORD VALUE]...)"
-  (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.
-\nKeywords supported:  :test :test-not :key
-\n(fn NEW OLD TREE [KEYWORD VALUE]...)"
-  (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 (key value alist)
-  "Add KEY and VALUE to ALIST.
-Return a new list with (cons KEY VALUE) as car and ALIST as cdr."
-  (cons (cons key value) alist))
-
-(defun pairlis (keys values &optional alist)
-  "Make an alist from KEYS and VALUES.
-Return a new alist composed by associating KEYS to corresponding VALUES;
-the process stops as soon as KEYS or VALUES run out.
-If ALIST is non-nil, the new pairs are prepended to it."
-  (nconc (mapcar* 'cons keys values) alist))
-
-
-;;; Miscellaneous.
-
-;; Define data for indentation and edebug.
-(dolist (entry
-         '(((defun* defmacro*) 2)
-           ((function*) nil
-            (&or symbolp ([&optional 'macro] 'lambda (&rest sexp) &rest form)))
-           ((eval-when) 1 (sexp &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))
-           ((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 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))))
-  (dolist (func (car entry))
-    (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)))))
-
-;; Autoload the other portions of the package.
-;; We want to replace the basic versions of dolist, dotimes, declare below.
-(fmakunbound 'dolist)
-(fmakunbound 'dotimes)
-(fmakunbound 'declare)
-(load "cl-loaddefs" nil 'quiet)
-
-;; This goes here so that cl-macs can find it if it loads right now.
-(provide 'cl)
-
-;; Things to do after byte-compiler is loaded.
-
-(defvar cl-hacked-flag nil)
-(defun cl-hack-byte-compiler ()
-  (and (not cl-hacked-flag) (fboundp 'byte-compile-file-form)
-       (progn
-         (setq cl-hacked-flag t)  ; Do it first, to prevent recursion.
-         (load "cl-macs" nil t)
-         (run-hooks 'cl-hack-bytecomp-hook))))
-
-;; 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.
-(add-hook 'bytecomp-load-hook 'cl-hack-byte-compiler)
-
-
-;; The following ensures that packages which expect the old-style cl.el
-;; will be happy with this one.
+;; Used in the expansion of the old `defstruct'.
+(defun cl-struct-setf-expander (x name accessor pred-form pos)
+  (declare (obsolete nil "24.3"))
+  (let* ((temp (make-symbol "--cl-x--")) (store (make-symbol "--cl-store--")))
+    (list (list temp) (list x) (list store)
+	  `(progn
+             ,@(and pred-form
+                    (list `(or ,(cl-subst temp 'cl-x pred-form)
+                               (error ,(format
+                                        "%s storing a non-%s"
+                                        accessor name)))))
+             ,(if (eq (car (get name 'cl-struct-type)) 'vector)
+                  `(aset ,temp ,pos ,store)
+                `(setcar
+                  ,(if (<= pos 5)
+                       (let ((xx temp))
+                         (while (>= (setq pos (1- pos)) 0)
+                           (setq xx `(cdr ,xx)))
+                         xx)
+                     `(nthcdr ,pos ,temp))
+                  ,store)))
+	  (list accessor temp))))
 
 (provide 'cl)
-
-(run-hooks 'cl-load-hook)
-
-;; Local variables:
-;; byte-compile-dynamic: t
-;; byte-compile-warnings: (not cl-functions)
-;; End:
-
 ;;; cl.el ends here
diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el
index 582785a0e90..c3616c6e490 100644
--- a/lisp/emacs-lisp/copyright.el
+++ b/lisp/emacs-lisp/copyright.el
@@ -1,6 +1,6 @@
 ;;; copyright.el --- update the copyright notice in current buffer
 
-;; Copyright (C) 1991-1995, 1998, 2001-2011  Free Software Foundation, Inc.
+;; Copyright (C) 1991-1995, 1998, 2001-2012  Free Software Foundation, Inc.
 
 ;; Author: Daniel Pfeiffer <occitan@esperanto.org>
 ;; Keywords: maint, tools
@@ -85,7 +85,7 @@ The second \\( \\) construct must match the years."
   "Non-nil if individual consecutive years should be replaced with a range.
 For example: 2005, 2006, 2007, 2008 might be replaced with 2005-2008.
 If you use ranges, you should add an explanatory note in a README file.
-The function `copyright-fix-year' respects this variable."
+The function `copyright-fix-years' respects this variable."
   :group 'copyright
   :type 'boolean
   :version "24.1")
@@ -110,7 +110,7 @@ When this is `function', only ask when called non-interactively."
 
 ;; This is a defvar rather than a defconst, because the year can
 ;; change during the Emacs session.
-(defvar copyright-current-year (substring (current-time-string) -4)
+(defvar copyright-current-year (format-time-string "%Y")
   "String representing the current year.")
 
 (defsubst copyright-limit ()            ; re-search-forward BOUND
@@ -181,8 +181,7 @@ skips to the end of all the years."
   ;; This uses the match-data from copyright-find-copyright/end.
   (goto-char (match-end 1))
   (copyright-find-end)
-  ;; Note that `current-time-string' isn't locale-sensitive.
-  (setq copyright-current-year (substring (current-time-string) -4))
+  (setq copyright-current-year (format-time-string "%Y"))
   (unless (string= (buffer-substring (- (match-end 3) 2) (match-end 3))
 		   (substring copyright-current-year -2))
     (if (or noquery
@@ -347,7 +346,7 @@ independently replaces consecutive years with a range."
   "Insert a copyright by $ORGANIZATION notice at cursor."
   "Company: "
   comment-start
-  "Copyright (C) " `(substring (current-time-string) -4) " by "
+  "Copyright (C) " `(format-time-string "%Y") " by "
   (or (getenv "ORGANIZATION")
       str)
   '(if (copyright-offset-too-large-p)
@@ -363,10 +362,11 @@ If FIX is non-nil, run `copyright-fix-years' instead."
   (dolist (file (directory-files directory t match nil))
     (unless (file-directory-p file)
       (message "Updating file `%s'" file)
-      (find-file file)
-      (let ((inhibit-read-only t)
-	    (enable-local-variables :safe)
-	    copyright-query)
+      ;; FIXME we should not use find-file+save+kill.
+      (let ((enable-local-variables :safe)
+	    (enable-local-eval nil))
+	(find-file file))
+      (let ((inhibit-read-only t))
 	(if fix
 	    (copyright-fix-years)
 	  (copyright-update)))
diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el
index 3848ab7e6ea..87c9b280bea 100644
--- a/lisp/emacs-lisp/crm.el
+++ b/lisp/emacs-lisp/crm.el
@@ -1,6 +1,6 @@
 ;;; crm.el --- read multiple strings with completion
 
-;; Copyright (C) 1985-1986, 1993-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1993-2012 Free Software Foundation, Inc.
 
 ;; Author: Sen Nagata <sen@eccosys.com>
 ;; Keywords: completion, minibuffer, multiple elements
@@ -143,7 +143,7 @@ nil if none.
 
 The value of FLAG is used to specify the type of completion operation.
 A value of nil specifies `try-completion'.  A value of t specifies
-`all-completions'.  A value of lambda specifes a test for an exact match.
+`all-completions'.  A value of lambda specifies a test for an exact match.
 
 For more information on STRING, PREDICATE, and FLAG, see the Elisp
 Reference sections on 'Programmed Completion' and 'Basic Completion
diff --git a/lisp/emacs-lisp/cust-print.el b/lisp/emacs-lisp/cust-print.el
deleted file mode 100644
index e7f9aae1c60..00000000000
--- a/lisp/emacs-lisp/cust-print.el
+++ /dev/null
@@ -1,683 +0,0 @@
-;;; cust-print.el --- handles print-level and print-circle
-
-;; Copyright (C) 1992, 2001-2011  Free Software Foundation, Inc.
-
-;; Author: Daniel LaLiberte <liberte@holonexus.org>
-;; Adapted-By: ESR
-;; Keywords: extensions
-
-;; LCD Archive Entry:
-;; cust-print|Daniel LaLiberte|liberte@holonexus.org
-;; |Handle print-level, print-circle and more.
-
-;; 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 3 of the License, 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.  If not, see <http://www.gnu.org/licenses/>.
-
-;;; 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:
-
-(defgroup cust-print nil
-  "Handles print-level and print-circle."
-  :prefix "print-"
-  :group 'lisp
-  :group 'extensions)
-
-;; 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)
-
-;; Emacs 18 doesn't 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.")
-
-(defcustom 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."
-  :type '(choice (const nil) integer)
-  :group 'cust-print)
-
-
-(defcustom 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."
-  :type 'boolean
-  :group 'cust-print)
-
-
-(defcustom custom-print-vectors nil
-  "Non-nil if printing of vectors should obey `print-level' and `print-length'."
-  :type 'boolean
-  :group 'cust-print)
-
-
-;; Custom printers
-;;==========================================================
-
-(defvar 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 Emacs Lisp 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 don't 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))
-    (mapc '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)
-  (mapc '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)
-  (mapc '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 &optional noescape)
-  "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, unless the optional
-second argument NOESCAPE is non-nil.
-
-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
-    ;; occurred during the last prin1-to-string and we are in debugger.
-    (with-current-buffer buf
-      (erase-buffer))
-    ;; We must be in the current-buffer when the print occurs.
-    (if noescape
-	(custom-princ object buf)
-      (custom-prin1 object buf))
-    (with-current-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
index d05a518e590..a378941a5a4 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -1,6 +1,6 @@
-;;; debug.el --- debuggers and related commands for Emacs
+;;; debug.el --- debuggers and related commands for Emacs  -*- lexical-binding: t -*-
 
-;; Copyright (C) 1985-1986, 1994, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1994, 2001-2012 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: lisp, tools, maint
@@ -48,8 +48,38 @@ the middle is discarded, and just the beginning and end are displayed."
   :group 'debugger
   :version "21.1")
 
-(defvar debug-function-list nil
-  "List of functions currently set for debug on entry.")
+(defcustom debugger-bury-or-kill 'bury
+  "What to do with the debugger buffer when exiting `debug'.
+The value affects the behavior of operations on any window
+previously showing the debugger buffer.
+
+`nil' means that if its window is not deleted when exiting the
+  debugger, invoking `switch-to-prev-buffer' will usually show
+  the debugger buffer again.
+
+`append' means that if the window is not deleted, the debugger
+  buffer moves to the end of the window's previous buffers so
+  it's less likely that a future invocation of
+  `switch-to-prev-buffer' will switch to it.  Also, it moves the
+  buffer to the end of the frame's buffer list.
+
+`bury' means that if the window is not deleted, its buffer is
+  removed from the window's list of previous buffers.  Also, it
+  moves the buffer to the end of the frame's buffer list.  This
+  value provides the most reliable remedy to not have
+  `switch-to-prev-buffer' switch to the debugger buffer again
+  without killing the buffer.
+
+`kill' means to kill the debugger buffer.
+
+The value used here is passed to `quit-restore-window'."
+  :type '(choice
+	  (const :tag "Keep alive" nil)
+	  (const :tag "Append" append)
+	  (const :tag "Bury" bury)
+	  (const :tag "Kill" kill))
+  :group 'debugger
+  :version "24.3")
 
 (defvar debugger-step-after-exit nil
   "Non-nil means \"single-step\" after the debugger exits.")
@@ -60,6 +90,12 @@ the middle is discarded, and just the beginning and end are displayed."
 (defvar debugger-old-buffer nil
   "This is the buffer that was current when the debugger was entered.")
 
+(defvar debugger-previous-window nil
+  "This is the window last showing the debugger buffer.")
+
+(defvar debugger-previous-window-height nil
+  "The last recorded height of `debugger-previous-window'.")
+
 (defvar debugger-previous-backtrace nil
   "The contents of the previous backtrace (including text properties).
 This is to optimize `debugger-make-xrefs'.")
@@ -71,10 +107,6 @@ This is to optimize `debugger-make-xrefs'.")
 (defvar debugger-outer-track-mouse)
 (defvar debugger-outer-last-command)
 (defvar debugger-outer-this-command)
-;; unread-command-char is obsolete,
-;; but we still save and restore it
-;; in case some user program still tries to set it.
-(defvar debugger-outer-unread-command-char)
 (defvar debugger-outer-unread-command-events)
 (defvar debugger-outer-unread-post-input-method-events)
 (defvar debugger-outer-last-input-event)
@@ -111,7 +143,7 @@ where CAUSE can be:
 ;;;###autoload
 (setq debugger 'debug)
 ;;;###autoload
-(defun debug (&rest debugger-args)
+(defun debug (&rest args)
   "Enter debugger.  \\<debugger-mode-map>`\\[debugger-continue]' returns from the debugger.
 Arguments are mainly for use when this is called from the internals
 of the evaluator.
@@ -126,14 +158,14 @@ first will be printed into the backtrace buffer."
     (unless noninteractive
       (message "Entering debugger..."))
     (let (debugger-value
-	  (debug-on-error nil)
-	  (debug-on-quit nil)
 	  (debugger-previous-state
            (if (get-buffer "*Backtrace*")
                (with-current-buffer (get-buffer "*Backtrace*")
                  (list major-mode (buffer-string)))))
+          (debugger-args args)
 	  (debugger-buffer (get-buffer-create "*Backtrace*"))
 	  (debugger-old-buffer (current-buffer))
+	  (debugger-window nil)
 	  (debugger-step-after-exit nil)
           (debugger-will-be-back nil)
 	  ;; Don't keep reading from an executing kbd macro!
@@ -148,8 +180,6 @@ first will be printed into the backtrace buffer."
 	  (debugger-outer-track-mouse track-mouse)
 	  (debugger-outer-last-command last-command)
 	  (debugger-outer-this-command this-command)
-	  (debugger-outer-unread-command-char
-	   (with-no-warnings unread-command-char))
 	  (debugger-outer-unread-command-events unread-command-events)
 	  (debugger-outer-unread-post-input-method-events
 	   unread-post-input-method-events)
@@ -181,81 +211,86 @@ first will be printed into the backtrace buffer."
 	     (or enable-recursive-minibuffers (> (minibuffer-depth) 0)))
 	    (standard-input t) (standard-output t)
 	    inhibit-redisplay
-	    (cursor-in-echo-area nil))
+	    (cursor-in-echo-area nil)
+	    (window-configuration (current-window-configuration)))
 	(unwind-protect
 	    (save-excursion
-	      (save-window-excursion
-		(with-no-warnings
-		  (setq unread-command-char -1))
-		(when (eq (car debugger-args) 'debug)
-		  ;; Skip the frames for backtrace-debug, byte-code,
-		  ;; and implement-debug-on-entry.
-		  (backtrace-debug 4 t)
-		  ;; Place an extra debug-on-exit for macro's.
-		  (when (eq 'lambda (car-safe (cadr (backtrace-frame 4))))
-		    (backtrace-debug 5 t)))
-                (pop-to-buffer debugger-buffer)
-		(debugger-mode)
-		(debugger-setup-buffer debugger-args)
-		(when noninteractive
-		  ;; If the backtrace is long, save the beginning
-		  ;; and the end, but discard the middle.
-		  (when (> (count-lines (point-min) (point-max))
-			   debugger-batch-max-lines)
-		    (goto-char (point-min))
-		    (forward-line (/ 2 debugger-batch-max-lines))
-		    (let ((middlestart (point)))
-		      (goto-char (point-max))
-		      (forward-line (- (/ 2 debugger-batch-max-lines)
-				       debugger-batch-max-lines))
-		      (delete-region middlestart (point)))
-		    (insert "...\n"))
+	      (when (eq (car debugger-args) 'debug)
+		;; Skip the frames for backtrace-debug, byte-code,
+		;; debug--implement-debug-on-entry and the advice's `apply'.
+		(backtrace-debug 4 t)
+		;; Place an extra debug-on-exit for macro's.
+		(when (eq 'lambda (car-safe (cadr (backtrace-frame 4))))
+		  (backtrace-debug 5 t)))
+	      (pop-to-buffer
+	       debugger-buffer
+	       `((display-buffer-reuse-window
+		  display-buffer-in-previous-window)
+		  . (,(when debugger-previous-window
+			`(previous-window . ,debugger-previous-window)))))
+	      (setq debugger-window (selected-window))
+	      (if (eq debugger-previous-window debugger-window)
+		  (when debugger-jumping-flag
+		    ;; Try to restore previous height of debugger
+		    ;; window.
+		    (condition-case nil
+			(window-resize
+			 debugger-window
+			 (- debugger-previous-window-height
+			    (window-total-size debugger-window)))
+		      (error nil)))
+		(setq debugger-previous-window debugger-window))
+	      (debugger-mode)
+	      (debugger-setup-buffer debugger-args)
+	      (when noninteractive
+		;; If the backtrace is long, save the beginning
+		;; and the end, but discard the middle.
+		(when (> (count-lines (point-min) (point-max))
+			 debugger-batch-max-lines)
 		  (goto-char (point-min))
-		  (message "%s" (buffer-string))
-		  (kill-emacs -1))
+		  (forward-line (/ 2 debugger-batch-max-lines))
+		  (let ((middlestart (point)))
+		    (goto-char (point-max))
+		    (forward-line (- (/ 2 debugger-batch-max-lines)
+				     debugger-batch-max-lines))
+		    (delete-region middlestart (point)))
+		  (insert "...\n"))
+		(goto-char (point-min))
+		(message "%s" (buffer-string))
+		(kill-emacs -1))
+	      (message "")
+	      (let ((standard-output nil)
+		    (buffer-read-only t))
 		(message "")
-		(let ((standard-output nil)
-		      (buffer-read-only t))
-		  (message "")
-		  ;; Make sure we unbind buffer-read-only in the right buffer.
-		  (save-excursion
-		    (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 0)
-	      ;; 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 (and maybe hide it) but keep it alive.
-	      (with-current-buffer debugger-buffer
-		(with-selected-window (get-buffer-window debugger-buffer 0)
-                  (when (and (window-dedicated-p (selected-window))
-                             (not debugger-will-be-back))
-                    ;; If the window is not dedicated, burying the buffer
-                    ;; will mean that the frame created for it is left
-                    ;; around showing some random buffer, and next time we
-                    ;; pop to the debugger buffer we'll create yet
-                    ;; another frame.
-                    ;; If debugger-will-be-back is non-nil, the frame
-                    ;; would need to be de-iconified anyway immediately
-                    ;; after when we re-enter the debugger, so iconifying it
-                    ;; here would cause flashing.
-                    ;; Drew Adams is not happy with this: he wants to frame
-                    ;; to be left at the top-level, still working on how
-                    ;; best to do that.
-                    (bury-buffer))))
-            (unless debugger-previous-state
-              (kill-buffer debugger-buffer)))
-          ;; Restore the previous state of the debugger-buffer, in case we were
-          ;; in a recursive invocation of the debugger.
-          (when (buffer-live-p debugger-buffer)
-            (with-current-buffer debugger-buffer
-              (let ((inhibit-read-only t))
-                (erase-buffer)
-                (if (null debugger-previous-state)
-                    (fundamental-mode)
-                  (insert (nth 1 debugger-previous-state))
-                  (funcall (nth 0 debugger-previous-state))))))
+		;; Make sure we unbind buffer-read-only in the right buffer.
+		(save-excursion
+		  (recursive-edit))))
+	  (when (and (window-live-p debugger-window)
+		     (eq (window-buffer debugger-window) debugger-buffer))
+	    ;; Record height of debugger window.
+	    (setq debugger-previous-window-height
+		  (window-total-size debugger-window)))
+	  (if debugger-will-be-back
+	      ;; Restore previous window configuration (Bug#12623).
+	      (set-window-configuration window-configuration)
+	    (when (and (window-live-p debugger-window)
+		       (eq (window-buffer debugger-window) debugger-buffer))
+	      (progn
+		;; Unshow debugger-buffer.
+		(quit-restore-window debugger-window debugger-bury-or-kill)
+		;; Restore current buffer (Bug#12502).
+		(set-buffer debugger-old-buffer))))
+          ;; Restore previous state of debugger-buffer in case we were
+          ;; in a recursive invocation of the debugger, otherwise just
+          ;; erase the buffer and put it into fundamental mode.
+	  (when (buffer-live-p debugger-buffer)
+	    (with-current-buffer debugger-buffer
+	      (let ((inhibit-read-only t))
+		(erase-buffer)
+		(if (null debugger-previous-state)
+		    (fundamental-mode)
+		  (insert (nth 1 debugger-previous-state))
+		  (funcall (nth 0 debugger-previous-state))))))
 	  (with-timeout-unsuspend debugger-with-timeout-suspend)
 	  (set-match-data debugger-outer-match-data)))
       ;; Put into effect the modified values of these variables
@@ -267,8 +302,6 @@ first will be printed into the backtrace buffer."
       (setq track-mouse debugger-outer-track-mouse)
       (setq last-command debugger-outer-last-command)
       (setq this-command debugger-outer-this-command)
-      (with-no-warnings
-	(setq unread-command-char debugger-outer-unread-command-char))
       (setq unread-command-events debugger-outer-unread-command-events)
       (setq unread-post-input-method-events
 	    debugger-outer-unread-post-input-method-events)
@@ -283,7 +316,7 @@ first will be printed into the backtrace buffer."
       (setq debug-on-next-call debugger-step-after-exit)
       debugger-value)))
 
-(defun debugger-setup-buffer (debugger-args)
+(defun debugger-setup-buffer (args)
   "Initialize the `*Backtrace*' buffer for entry to the debugger.
 That buffer should be current already."
   (setq buffer-read-only nil)
@@ -299,20 +332,22 @@ That buffer should be current already."
   (delete-region (point)
 		 (progn
 		   (search-forward "\n  debug(")
-		   (forward-line (if (eq (car debugger-args) 'debug)
-				     2	; Remove implement-debug-on-entry frame.
+		   (forward-line (if (eq (car args) 'debug)
+                                     ;; Remove debug--implement-debug-on-entry
+                                     ;; and the advice's `apply' frame.
+				     3
 				   1))
 		   (point)))
   (insert "Debugger entered")
   ;; lambda is for debug-on-call when a function call is next.
   ;; debug is for debug-on-entry function called.
-  (pcase (car debugger-args)
+  (pcase (car args)
     ((or `lambda `debug)
      (insert "--entering a function:\n"))
     ;; Exiting a function.
     (`exit
      (insert "--returning value: ")
-     (setq debugger-value (nth 1 debugger-args))
+     (setq debugger-value (nth 1 args))
      (prin1 debugger-value (current-buffer))
      (insert ?\n)
      (delete-char 1)
@@ -321,7 +356,7 @@ That buffer should be current already."
     ;; Debugger entered for an error.
     (`error
      (insert "--Lisp error: ")
-     (prin1 (nth 1 debugger-args) (current-buffer))
+     (prin1 (nth 1 args) (current-buffer))
      (insert ?\n))
     ;; debug-on-call, when the next thing is an eval.
     (`t
@@ -329,8 +364,8 @@ That buffer should be current already."
     ;; User calls debug directly.
     (_
      (insert ": ")
-     (prin1 (if (eq (car debugger-args) 'nil)
-                (cdr debugger-args) debugger-args)
+     (prin1 (if (eq (car args) 'nil)
+                (cdr args) args)
             (current-buffer))
      (insert ?\n)))
   ;; After any frame that uses eval-buffer,
@@ -490,9 +525,10 @@ removes itself from that hook."
 	  (count 0))
       (while (not (eq (cadr (backtrace-frame count)) 'debug))
 	(setq count (1+ count)))
-      ;; Skip implement-debug-on-entry frame.
-      (when (eq 'implement-debug-on-entry (cadr (backtrace-frame (1+ count))))
-	(setq count (1+ count)))
+      ;; Skip debug--implement-debug-on-entry frame.
+      (when (eq 'debug--implement-debug-on-entry
+                (cadr (backtrace-frame (1+ count))))
+	(setq count (+ 2 count)))
       (goto-char (point-min))
       (when (looking-at "Debugger entered--\\(Lisp error\\|returning value\\):")
 	(goto-char (match-end 0))
@@ -570,16 +606,7 @@ Applies to the frame whose line point is on in the backtrace."
           (cursor-in-echo-area debugger-outer-cursor-in-echo-area))
       (set-match-data debugger-outer-match-data)
       (prog1
-	  (let ((save-ucc (with-no-warnings unread-command-char)))
-	    (unwind-protect
-		(progn
-		  (with-no-warnings
-		    (setq unread-command-char debugger-outer-unread-command-char))
-		  (prog1 (progn ,@body)
-		    (with-no-warnings
-		      (setq debugger-outer-unread-command-char unread-command-char))))
-	      (with-no-warnings
-		(setq unread-command-char save-ucc))))
+          (progn ,@body)
         (setq debugger-outer-match-data (match-data))
         (setq debugger-outer-load-read-function load-read-function)
         (setq debugger-outer-overriding-terminal-local-map
@@ -668,10 +695,10 @@ Applies to the frame whose line point is on in the backtrace."
 		  :help "Continue to exit from this frame, with all debug-on-entry suspended"))
     (define-key menu-map [deb-cont]
       '(menu-item "Continue" debugger-continue
-		  :help "Continue, evaluating this expression without stopping"))
+	:help "Continue, evaluating this expression without stopping"))
     (define-key menu-map [deb-step]
       '(menu-item "Step through" debugger-step-through
-		  :help "Proceed, stepping through subexpressions of this expression"))
+	:help "Proceed, stepping through subexpressions of this expression"))
     map))
 
 (put 'debugger-mode 'mode-class 'special)
@@ -751,7 +778,7 @@ For the cross-reference format, see `help-make-xrefs'."
 
 ;; When you change this, you may also need to change the number of
 ;; frames that the debugger skips.
-(defun implement-debug-on-entry ()
+(defun debug--implement-debug-on-entry (&rest _ignore)
   "Conditionally call the debugger.
 A call to this function is inserted by `debug-on-entry' to cause
 functions to break on entry."
@@ -759,12 +786,6 @@ functions to break on entry."
       nil
     (funcall debugger 'debug)))
 
-(defun debugger-special-form-p (symbol)
-  "Return whether SYMBOL is a special form."
-  (and (fboundp symbol)
-       (subrp (symbol-function symbol))
-       (eq (cdr (subr-arity (symbol-function symbol))) 'unevalled)))
-
 ;;;###autoload
 (defun debug-on-entry (function)
   "Request FUNCTION to invoke debugger each time it is called.
@@ -782,7 +803,7 @@ Use \\[cancel-debug-on-entry] to cancel the effect of this command.
 Redefining FUNCTION also cancels it."
   (interactive
    (let ((fn (function-called-at-point)) val)
-     (when (debugger-special-form-p fn)
+     (when (special-form-p fn)
        (setq fn nil))
      (setq val (completing-read
 		(if fn
@@ -791,36 +812,21 @@ Redefining FUNCTION also cancels it."
 		obarray
 		#'(lambda (symbol)
 		    (and (fboundp symbol)
-			 (not (debugger-special-form-p symbol))))
+			 (not (special-form-p symbol))))
 		t nil nil (symbol-name fn)))
      (list (if (equal val "") fn (intern val)))))
-  ;; FIXME: Use advice.el.
-  (when (debugger-special-form-p function)
-    (error "Function %s is a special form" function))
-  (if (or (symbolp (symbol-function function))
-	  (subrp (symbol-function function)))
-      ;; The function is built-in or aliased to another function.
-      ;; Create a wrapper in which we can add the debug call.
-      (fset function `(lambda (&rest debug-on-entry-args)
-			,(interactive-form (symbol-function function))
-			(apply ',(symbol-function function)
-			       debug-on-entry-args)))
-    (when (eq (car-safe (symbol-function function)) 'autoload)
-      ;; The function is autoloaded.  Load its real definition.
-      (load (cadr (symbol-function function)) nil noninteractive nil t))
-    (when (or (not (consp (symbol-function function)))
-	      (and (eq (car (symbol-function function)) 'macro)
-		   (not (consp (cdr (symbol-function function))))))
-      ;; The function is byte-compiled.  Create a wrapper in which
-      ;; we can add the debug call.
-      (debug-convert-byte-code function)))
-  (unless (consp (symbol-function function))
-    (error "Definition of %s is not a list" function))
-  (fset function (debug-on-entry-1 function t))
-  (unless (memq function debug-function-list)
-    (push function debug-function-list))
+  (advice-add function :before #'debug--implement-debug-on-entry)
   function)
 
+(defun debug--function-list ()
+  "List of functions currently set for debug on entry."
+  (let ((funs '()))
+    (mapatoms
+     (lambda (s)
+       (when (advice-member-p #'debug--implement-debug-on-entry s)
+         (push s funs))))
+    funs))
+
 ;;;###autoload
 (defun cancel-debug-on-entry (&optional function)
   "Undo effect of \\[debug-on-entry] on FUNCTION.
@@ -831,80 +837,16 @@ To specify a nil argument interactively, exit with an empty minibuffer."
    (list (let ((name
 		(completing-read
 		 "Cancel debug on entry to function (default all functions): "
-		 (mapcar 'symbol-name debug-function-list) nil t)))
+		 (mapcar #'symbol-name (debug--function-list)) nil t)))
 	   (when name
 	     (unless (string= name "")
 	       (intern name))))))
-  (if (and function
-	   (not (string= function ""))) ; Pre 22.1 compatibility test.
+  (if function
       (progn
-	(let ((defn (debug-on-entry-1 function nil)))
-	  (condition-case nil
-	      (when (and (equal (nth 1 defn) '(&rest debug-on-entry-args))
-			 (eq (car (nth 3 defn)) 'apply))
-		;; `defn' is a wrapper introduced in debug-on-entry.
-		;; Get rid of it since we don't need it any more.
-		(setq defn (nth 1 (nth 1 (nth 3 defn)))))
-	    (error nil))
-	  (fset function defn))
-	(setq debug-function-list (delq function debug-function-list))
+        (advice-remove function #'debug--implement-debug-on-entry)
 	function)
     (message "Cancelling debug-on-entry for all functions")
-    (mapcar 'cancel-debug-on-entry debug-function-list)))
-
-(defun debug-arglist (definition)
-  ;; FIXME: copied from ad-arglist.
-  "Return the argument list of DEFINITION."
-  (require 'help-fns)
-  (help-function-arglist definition 'preserve-names))
-
-(defun debug-convert-byte-code (function)
-  (let* ((defn (symbol-function function))
-	 (macro (eq (car-safe defn) 'macro)))
-    (when macro (setq defn (cdr defn)))
-    (when (byte-code-function-p defn)
-      (let* ((args (debug-arglist defn))
-	     (body
-              `((,(if (memq '&rest args) #'apply #'funcall)
-                 ,defn
-                 ,@(remq '&rest (remq '&optional args))))))
-	(if (> (length defn) 5)
-            ;; The mere presence of field 5 is sufficient to make
-            ;; it interactive.
-	    (push `(interactive ,(aref defn 5)) body))
-	(if (and (> (length defn) 4) (aref defn 4))
-	    ;; 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)))
-	(setq defn `(closure (t) ,args ,@body)))
-      (when macro (setq defn (cons 'macro defn)))
-      (fset function defn))))
-
-(defun debug-on-entry-1 (function flag)
-  (let* ((defn (symbol-function function))
-	 (tail defn))
-    (when (eq (car-safe tail) 'macro)
-      (setq tail (cdr tail)))
-    (if (not (memq (car-safe tail) '(closure lambda)))
-	;; Only signal an error when we try to set debug-on-entry.
-	;; When we try to clear debug-on-entry, we are now done.
-	(when flag
-	  (error "%s is not a user-defined Lisp function" function))
-      (if (eq (car tail) 'closure) (setq tail (cdr tail)))
-      (setq tail (cdr tail))
-      ;; Skip the docstring.
-      (when (and (stringp (cadr tail)) (cddr tail))
-	(setq tail (cdr tail)))
-      ;; Skip the interactive form.
-      (when (eq 'interactive (car-safe (cadr tail)))
-	(setq tail (cdr tail)))
-      (unless (eq flag (equal (cadr tail) '(implement-debug-on-entry)))
-	;; Add/remove debug statement as needed.
-	(setcdr tail (if flag
-                         (cons '(implement-debug-on-entry) (cdr tail))
-                       (cddr tail)))))
-    defn))
+    (mapcar #'cancel-debug-on-entry (debug--function-list))))
 
 (defun debugger-list-functions ()
   "Display a list of all the functions now set to debug on entry."
@@ -914,17 +856,18 @@ To specify a nil argument interactively, exit with an empty minibuffer."
 		   (called-interactively-p 'interactive))
   (with-output-to-temp-buffer (help-buffer)
     (with-current-buffer standard-output
-      (if (null debug-function-list)
-	  (princ "No debug-on-entry functions now\n")
-	(princ "Functions set to debug on entry:\n\n")
-	(dolist (fun debug-function-list)
-	  (make-text-button (point) (progn (prin1 fun) (point))
-			    'type 'help-function
-			    'help-args (list fun))
-	  (terpri))
-	(terpri)
-	(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.")))))
+      (let ((funs (debug--function-list)))
+        (if (null funs)
+            (princ "No debug-on-entry functions now\n")
+          (princ "Functions set to debug on entry:\n\n")
+          (dolist (fun funs)
+            (make-text-button (point) (progn (prin1 fun) (point))
+                              'type 'help-function
+                              'help-args (list fun))
+            (terpri))
+          (terpri)
+          (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."))))))
 
 (provide 'debug)
 
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index 55ea102ed2a..8c8d37b2194 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -1,7 +1,7 @@
 ;;; derived.el --- allow inheritance of major modes
 ;; (formerly mode-clone.el)
 
-;; Copyright (C) 1993-1994, 1999, 2001-2011  Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 1999, 2001-2012  Free Software Foundation, Inc.
 
 ;; Author: David Megginson (dmeggins@aix1.uottawa.ca)
 ;; Maintainer: FSF
@@ -90,8 +90,6 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'cl))
-
 ;;; PRIVATE: defsubst must be defined before they are first used
 
 (defsubst derived-mode-hook-name (mode)
@@ -183,11 +181,11 @@ See Info node `(elisp)Derived Modes' for more details."
 
     ;; Process the keyword args.
     (while (keywordp (car body))
-      (case (pop body)
-	(:group (setq group (pop body)))
-	(:abbrev-table (setq abbrev (pop body)) (setq declare-abbrev nil))
-	(:syntax-table (setq syntax (pop body)) (setq declare-syntax nil))
-	(t (pop body))))
+      (pcase (pop body)
+	(`:group (setq group (pop body)))
+	(`:abbrev-table (setq abbrev (pop body)) (setq declare-abbrev nil))
+	(`:syntax-table (setq syntax (pop body)) (setq declare-syntax nil))
+	(_ (pop body))))
 
     (setq docstring (derived-mode-make-docstring
 		     parent child docstring syntax abbrev))
@@ -278,10 +276,10 @@ A mode's class is the first ancestor which is NOT a derived mode.
 Use the `derived-mode-parent' property of the symbol to trace backwards.
 Since major-modes might all derive from `fundamental-mode', this function
 is not very useful."
+  (declare (obsolete derived-mode-p "22.1"))
   (while (get mode 'derived-mode-parent)
     (setq mode (get mode 'derived-mode-parent)))
   mode)
-(make-obsolete 'derived-mode-class 'derived-mode-p "22.1")
 
 
 ;;; PRIVATE
diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el
index 2a41e611dc0..206166bc77a 100644
--- a/lisp/emacs-lisp/disass.el
+++ b/lisp/emacs-lisp/disass.el
@@ -1,6 +1,6 @@
 ;;; disass.el --- disassembler for compiled Emacs Lisp code
 
-;; Copyright (C) 1986, 1991, 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1986, 1991, 2002-2012 Free Software Foundation, Inc.
 
 ;; Author: Doug Cutting <doug@csli.stanford.edu>
 ;;	Jamie Zawinski <jwz@lucid.com>
@@ -35,6 +35,8 @@
 
 ;;; Code:
 
+(require 'macroexp)
+
 ;;; 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.
@@ -78,14 +80,10 @@ redefine OBJECT if it is a symbol."
 	    obj (symbol-function obj)))
     (if (subrp obj)
 	(error "Can't disassemble #<subr %s>" name))
-    (when (and (listp obj) (eq (car obj) 'autoload))
-      (load (nth 1 obj))
-      (setq obj (symbol-function name)))
-    (if (eq (car-safe obj) 'macro)	;handle macros
+    (setq obj (autoload-do-load obj name))
+    (if (eq (car-safe obj) 'macro)	;Handle macros.
 	(setq macro t
 	      obj (cdr obj)))
-    (when (and (listp obj) (eq (car obj) 'closure))
-      (error "Don't know how to compile an interpreted closure"))
     (if (and (listp obj) (eq (car obj) 'byte-code))
 	(setq obj (list 'lambda nil obj)))
     (if (and (listp obj) (not (eq (car obj) 'lambda)))
@@ -155,7 +153,7 @@ redefine OBJECT if it is a symbol."
 	  (t
 	   (insert "Uncompiled body:  ")
 	   (let ((print-escape-newlines t))
-	     (prin1 (if (cdr obj) (cons 'progn obj) (car obj))
+	     (prin1 (macroexp-progn obj)
 		    (current-buffer))))))
   (if interactive-p
       (message "")))
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index fae4d9adc38..4951368aebe 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -1,6 +1,6 @@
 ;;; easy-mmode.el --- easy definition for major and minor modes
 
-;; Copyright (C) 1997, 2000-2011  Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2000-2012  Free Software Foundation, Inc.
 
 ;; Author: Georges Brun-Cottan <Georges.Brun-Cottan@inria.fr>
 ;; Maintainer: Stefan Monnier <monnier@gnu.org>
@@ -51,8 +51,6 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'cl))
-
 (defun easy-mmode-pretty-mode-name (mode &optional lighter)
   "Turn the symbol MODE into a string intended for the user.
 If provided, LIGHTER will be used to help choose capitalization by,
@@ -67,7 +65,8 @@ replacing its case-insensitive matches with the literal string in LIGHTER."
 			;; "foo-bar-minor" -> "Foo-Bar-Minor"
 			(capitalize (replace-regexp-in-string
 				     ;; "foo-bar-minor-mode" -> "foo-bar-minor"
-				     "-mode\\'" "" (symbol-name mode))))
+				     "toggle-\\|-mode\\'" ""
+                                     (symbol-name mode))))
 		       " mode")))
     (if (not (stringp lighter)) name
       ;; Strip leading and trailing whitespace from LIGHTER.
@@ -86,11 +85,25 @@ replacing its case-insensitive matches with the literal string in LIGHTER."
 ;;;###autoload
 (defmacro define-minor-mode (mode doc &optional init-value lighter keymap &rest body)
   "Define a new minor mode MODE.
-This defines the control variable MODE and the toggle command MODE.
+This defines the toggle command MODE and (by default) a control variable
+MODE (you can override this with the :variable keyword, see below).
 DOC is the documentation for the mode toggle command.
 
+The defined mode command takes one optional (prefix) argument.
+Interactively with no prefix argument, it toggles the mode.
+A prefix argument enables the mode if the argument is positive,
+and disables it otherwise.
+
+When called from Lisp, the mode command toggles the mode if the
+argument is `toggle', disables the mode if the argument is a
+non-positive integer, and enables the mode otherwise (including
+if the argument is omitted or nil or a positive integer).
+
+If DOC is nil, give the mode command a basic doc-string
+documenting what its argument does.
+
 Optional INIT-VALUE is the initial value of the mode's variable.
-Optional LIGHTER is displayed in the modeline when the mode is on.
+Optional LIGHTER is displayed in the mode line when the mode is on.
 Optional KEYMAP is the default keymap bound to the mode keymap.
   If non-nil, it should be a variable name (whose value is a keymap),
   or an expression that returns either a keymap or a list of
@@ -113,21 +126,28 @@ BODY contains code to execute each time the mode is enabled or disabled.
 		buffer-local, so don't make the variable MODE buffer-local.
 		By default, the mode is buffer-local.
 :init-value VAL	Same as the INIT-VALUE argument.
+		Not used if you also specify :variable.
 :lighter SPEC	Same as the LIGHTER argument.
 :keymap MAP	Same as the KEYMAP argument.
 :require SYM	Same as in `defcustom'.
-:variable PLACE	The location (as can be used with `setf') to use instead
-		of the variable MODE to store the state of the mode.  PLACE
-		can also be of the form (GET . SET) where GET is an expression
-		that returns the current state and SET is a function that takes
-		a new state and sets it.  If you specify a :variable, this
-		function assumes it is defined elsewhere.
+:variable PLACE	The location to use instead of the variable MODE to store
+		the state of the mode.	This can be simply a different
+		named variable, or more generally anything that can be used
+		with the CL macro `setf'.  PLACE can also be of the form
+		\(GET . SET), where GET is an expression that returns the
+		current state, and SET is a function that takes one argument,
+		the new state, and sets it.  If you specify a :variable,
+		this function does not define a MODE variable (nor any of
+		the terms used in :variable).
+:after-hook     A single lisp form which is evaluated after the mode hooks
+                have been run.  It should not be quoted.
 
 For example, you could write
   (define-minor-mode foo-mode \"If enabled, foo on you!\"
     :lighter \" Foo\" :require 'foo :global t :group 'hassle :version \"27.5\"
     ...BODY CODE...)"
-  (declare (debug (&define name stringp
+  (declare (doc-string 2)
+           (debug (&define name stringp
 			   [&optional [&not keywordp] sexp
 			    &optional [&not keywordp] sexp
 			    &optional [&not keywordp] sexp]
@@ -137,10 +157,10 @@ For example, you could write
   ;; Allow skipping the first three args.
   (cond
    ((keywordp init-value)
-    (setq body (list* init-value lighter keymap body)
+    (setq body `(,init-value ,lighter ,keymap ,@body)
 	  init-value nil lighter nil keymap nil))
    ((keywordp lighter)
-    (setq body (list* lighter keymap body) lighter nil keymap nil))
+    (setq body `(,lighter ,keymap ,@body) lighter nil keymap nil))
    ((keywordp keymap) (push keymap body) (setq keymap nil)))
 
   (let* ((last-message (make-symbol "last-message"))
@@ -157,32 +177,36 @@ For example, you could write
          (setter nil)            ;The function (if any) to set the mode var.
          (modefun mode)          ;The minor mode function name we're defining.
 	 (require t)
+	 (after-hook nil)
 	 (hook (intern (concat mode-name "-hook")))
 	 (hook-on (intern (concat mode-name "-on-hook")))
 	 (hook-off (intern (concat mode-name "-off-hook")))
-	 keyw keymap-sym)
+	 keyw keymap-sym tmp)
 
     ;; Check keys.
     (while (keywordp (setq keyw (car body)))
       (setq body (cdr body))
-      (case keyw
-	(:init-value (setq init-value (pop body)))
-	(:lighter (setq lighter (purecopy (pop body))))
-	(:global (setq globalp (pop body)))
-	(:extra-args (setq extra-args (pop body)))
-	(:set (setq set (list :set (pop body))))
-	(:initialize (setq initialize (list :initialize (pop body))))
-	(:group (setq group (nconc group (list :group (pop body)))))
-	(:type (setq type (list :type (pop body))))
-	(:require (setq require (pop body)))
-	(:keymap (setq keymap (pop body)))
-        (:variable (setq variable (pop body))
-         (if (not (functionp (cdr-safe variable)))
+      (pcase keyw
+	(`:init-value (setq init-value (pop body)))
+	(`:lighter (setq lighter (purecopy (pop body))))
+	(`:global (setq globalp (pop body)))
+	(`:extra-args (setq extra-args (pop body)))
+	(`:set (setq set (list :set (pop body))))
+	(`:initialize (setq initialize (list :initialize (pop body))))
+	(`:group (setq group (nconc group (list :group (pop body)))))
+	(`:type (setq type (list :type (pop body))))
+	(`:require (setq require (pop body)))
+	(`:keymap (setq keymap (pop body)))
+        (`:variable (setq variable (pop body))
+         (if (not (and (setq tmp (cdr-safe variable))
+                       (or (symbolp tmp)
+                           (functionp tmp))))
              ;; PLACE is not of the form (GET . SET).
              (setq mode variable)
            (setq mode (car variable))
            (setq setter (cdr variable))))
-	(t (push keyw extra-keywords) (push (pop body) extra-keywords))))
+	(`:after-hook (setq after-hook (pop body)))
+	(_ (push keyw extra-keywords) (push (pop body) extra-keywords))))
 
     (setq keymap-sym (if (and keymap (symbolp keymap)) keymap
 		       (intern (concat mode-name "-map"))))
@@ -209,6 +233,7 @@ For example, you could write
          (variable nil)
          ((not globalp)
           `(progn
+             :autoload-end
              (defvar ,mode ,init-value ,(format "Non-nil if %s is enabled.
 Use the command `%s' to change this variable." pretty-name mode))
              (make-variable-buffer-local ',mode)))
@@ -235,13 +260,13 @@ or call the function `%s'."))))
 	      (format (concat "Toggle %s on or off.
 With a prefix argument ARG, enable %s if ARG is
 positive, and disable it otherwise.  If called from Lisp, enable
-the mode if ARG is omitted or nil.
+the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
 \\{%s}") pretty-name pretty-name keymap-sym))
 	 ;; Use `toggle' rather than (if ,mode 0 1) so that using
 	 ;; repeat-command still does the toggling correctly.
 	 (interactive (list (or current-prefix-arg 'toggle)))
 	 (let ((,last-message (current-message)))
-           (,@(if setter (list setter)
+           (,@(if setter `(funcall #',setter)
                 (list (if (symbolp mode) 'setq 'setf) mode))
             (if (eq arg 'toggle)
                 (not ,mode)
@@ -260,7 +285,8 @@ the mode if ARG is omitted or nil.
                               (not (equal ,last-message
                                           (current-message))))
                    (message ,(format "%s %%sabled" pretty-name)
-                            (if ,mode "en" "dis"))))))
+                            (if ,mode "en" "dis")))))
+	   ,@(when after-hook `(,after-hook)))
 	 (force-mode-line-update)
 	 ;; Return the new setting.
 	 ,mode)
@@ -286,7 +312,7 @@ the mode if ARG is omitted or nil.
                            ,(if keymap keymap-sym
                                 `(if (boundp ',keymap-sym) ,keymap-sym))
                              nil
-                             ,(unless (eq mode modefun) 'modefun)))))))
+                             ,(unless (eq mode modefun) `',modefun)))))))
 
 ;;;
 ;;; make global minor mode
@@ -315,7 +341,7 @@ enabled, then disabling and reenabling MODE should make MODE work
 correctly with the current major mode.  This is important to
 prevent problems with derived modes, that is, major modes that
 call another major mode in their body."
-
+  (declare (doc-string 2))
   (let* ((global-mode-name (symbol-name global-mode))
 	 (pretty-name (easy-mmode-pretty-mode-name mode))
 	 (pretty-global-name (easy-mmode-pretty-mode-name global-mode))
@@ -333,10 +359,10 @@ call another major mode in their body."
     ;; Check keys.
     (while (keywordp (setq keyw (car keys)))
       (setq keys (cdr keys))
-      (case keyw
-	(:group (setq group (nconc group (list :group (pop keys)))))
-	(:global (setq keys (cdr keys)))
-	(t (push keyw extra-keywords) (push (pop keys) extra-keywords))))
+      (pcase keyw
+	(`:group (setq group (nconc group (list :group (pop keys)))))
+	(`:global (setq keys (cdr keys)))
+	(_ (push keyw extra-keywords) (push (pop keys) extra-keywords))))
 
     (unless group
       ;; We might as well provide a best-guess default group.
@@ -345,8 +371,10 @@ call another major mode in their body."
 				"-mode\\'" "" (symbol-name mode))))))
 
     `(progn
-       (defvar ,MODE-major-mode nil)
-       (make-variable-buffer-local ',MODE-major-mode)
+       (progn
+         :autoload-end
+         (defvar ,MODE-major-mode nil)
+         (make-variable-buffer-local ',MODE-major-mode))
        ;; The actual global minor-mode
        (define-minor-mode ,global-mode
 	 ;; Very short lines to avoid too long lines in the generated
@@ -455,13 +483,13 @@ Valid keywords and arguments are:
     (while args
       (let ((key (pop args))
 	    (val (pop args)))
-	(case key
-	 (:name (setq name val))
-	 (:dense (setq dense val))
-	 (:inherit (setq inherit val))
-	 (:suppress (setq suppress val))
-	 (:group)
-	 (t (message "Unknown argument %s in defmap" key)))))
+	(pcase key
+	 (`:name (setq name val))
+	 (`:dense (setq dense val))
+	 (`:inherit (setq inherit val))
+	 (`:suppress (setq suppress val))
+	 (`:group)
+	 (_ (message "Unknown argument %s in defmap" key)))))
     (unless (keymapp m)
       (setq bs (append m bs))
       (setq m (if dense (make-keymap name) (make-sparse-keymap name))))
@@ -552,8 +580,6 @@ BODY is executed after moving to the destination location."
                  (when was-narrowed (,narrowfun)))))))
     (unless name (setq name base-name))
     `(progn
-       (add-to-list 'debug-ignored-errors
-		    ,(concat "^No \\(previous\\|next\\) " (regexp-quote name)))
        (defun ,next-sym (&optional count)
 	 ,(format "Go to the next COUNT'th %s." name)
 	 (interactive "p")
@@ -564,7 +590,7 @@ BODY is executed after moving to the destination location."
              `(if (not (re-search-forward ,re nil t count))
                   (if (looking-at ,re)
                       (goto-char (or ,(if endfun `(,endfun)) (point-max)))
-                    (error "No next %s" ,name))
+                    (user-error "No next %s" ,name))
                 (goto-char (match-beginning 0))
                 (when (and (eq (current-buffer) (window-buffer (selected-window)))
                            (called-interactively-p 'interactive))
@@ -583,7 +609,7 @@ BODY is executed after moving to the destination location."
 	 (if (< count 0) (,next-sym (- count))
            ,(funcall when-narrowed
              `(unless (re-search-backward ,re nil t count)
-                (error "No previous %s" ,name)))
+                (user-error "No previous %s" ,name)))
            ,@body))
        (put ',prev-sym 'definition-name ',base))))
 
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el
index 79573437146..26a1fce2309 100644
--- a/lisp/emacs-lisp/easymenu.el
+++ b/lisp/emacs-lisp/easymenu.el
@@ -1,6 +1,6 @@
 ;;; easymenu.el --- support the easymenu interface for defining a menu
 
-;; Copyright (C) 1994, 1996, 1998-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1996, 1998-2012 Free Software Foundation, Inc.
 
 ;; Keywords: emulations
 ;; Author: Richard Stallman <rms@gnu.org>
@@ -29,8 +29,6 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'cl))
-
 (defvar easy-menu-precalculate-equivalent-keybindings nil
   "Determine when equivalent key bindings are computed for easy-menu menus.
 It can take some time to calculate the equivalent key bindings that are shown
@@ -46,111 +44,102 @@ menus, turn this variable off, otherwise it is probably better to keep it on.")
 
 ;;;###autoload
 (defmacro easy-menu-define (symbol maps doc menu)
-  "Define a menu bar submenu in maps MAPS, according to MENU.
-
-If SYMBOL is non-nil, store the menu keymap in the value of SYMBOL,
-and define SYMBOL as a function to pop up the menu, with DOC as its doc string.
-If SYMBOL is nil, just store the menu keymap into MAPS.
-
-The first element of MENU must be a string.  It is the menu bar item name.
-It may be followed by the following keyword argument pairs
-
-   :filter FUNCTION
+  "Define a pop-up menu and/or menu bar menu specified by MENU.
+If SYMBOL is non-nil, define SYMBOL as a function to pop up the
+submenu defined by MENU, with DOC as its doc string.
 
-FUNCTION is a function with one argument, the rest of menu items.
-It returns the remaining items of the displayed menu.
+MAPS, if non-nil, should be a keymap or a list of keymaps; add
+the submenu defined by MENU to the keymap or each of the keymaps,
+as a top-level menu bar item.
 
-   :visible INCLUDE
+The first element of MENU must be a string.  It is the menu bar
+item name.  It may be followed by the following keyword argument
+pairs:
 
-INCLUDE is an expression; this menu is only visible if this
-expression has a non-nil value.  `:included' is an alias for `:visible'.
+ :filter FUNCTION
+    FUNCTION must be a function which, if called with one
+    argument---the list of the other menu items---returns the
+    items to actually display.
 
-   :active ENABLE
+ :visible INCLUDE
+    INCLUDE is an expression.  The menu is visible if the
+    expression evaluates to a non-nil value.  `:included' is an
+    alias for `:visible'.
 
-ENABLE is an expression; the menu is enabled for selection whenever
-this expression's value is non-nil.  `:enable' is an alias for `:active'.
+ :active ENABLE
+    ENABLE is an expression.  The menu is enabled for selection
+    if the expression evaluates to a non-nil value.  `:enable' is
+    an alias for `:active'.
 
-The rest of the elements in MENU, are menu items.
+The rest of the elements in MENU are menu items.
+A menu item can be a vector of three elements:
 
-A menu item is usually a vector of three elements:  [NAME CALLBACK ENABLE]
+  [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.
+CALLBACK is a command to run when the item is chosen, or an
+expression 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.
+ENABLE is an expression; the item is enabled for selection if the
+expression evaluates to a non-nil value.
 
 Alternatively, a menu item may have the form:
 
-   [ NAME CALLBACK [ KEYWORD ARG ] ... ]
-
-Where KEYWORD is one of the symbols 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.
-KEYS is expanded with `substitute-command-keys' before it is used.
-
-   :key-sequence KEYS
-
-KEYS is nil, a string or a vector; nil or a keyboard equivalent to this
-menu item.
-This is a hint that will considerably speed up Emacs' first display of
-a menu.  Use `:key-sequence nil' when you know that this menu item has no
-keyboard equivalent.
-
-   :active ENABLE
-
-ENABLE is an expression; the item is enabled for selection whenever
-this expression's value is non-nil.  `:enable' is an alias for `:active'.
-
-   :visible INCLUDE
-
-INCLUDE is an expression; this item is only visible if this
-expression has a non-nil value.  `:included' is an alias for `:visible'.
-
-   :label FORM
+   [ NAME CALLBACK [ KEYWORD ARG ]... ]
 
-FORM is an expression that will be dynamically evaluated and whose
-value will be used for the menu entry's text label (the default is NAME).
+where NAME and CALLBACK have the same meanings as above, and each
+optional KEYWORD and ARG pair should be one of the following:
 
-   :suffix FORM
+ :keys KEYS
+    KEYS is a string; a keyboard equivalent to the menu item.
+    This is normally not needed because keyboard equivalents are
+    usually computed automatically.  KEYS is expanded with
+    `substitute-command-keys' before it is used.
 
-FORM is an expression that will be dynamically evaluated and whose
-value will be concatenated to the menu entry's label.
+ :key-sequence KEYS
+    KEYS is a hint for speeding up Emacs's first display of the
+    menu.  It should be nil if you know that the menu item has no
+    keyboard equivalent; otherwise it should be a string or
+    vector specifying a keyboard equivalent for the menu item.
 
-   :style STYLE
+ :active ENABLE
+    ENABLE is an expression; the item is enabled for selection
+    whenever this expression's value is non-nil.  `:enable' is an
+    alias for `:active'.
 
-STYLE is a symbol describing the type of menu item.  The following are
-defined:
+ :visible INCLUDE
+    INCLUDE is an expression; this item is only visible if this
+    expression has a non-nil value.  `:included' is an alias for
+    `:visible'.
 
-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.
-button: Surround the name with `[' and `]'.  Use this for an item in the
-        menu bar itself.
-anything else means an ordinary menu item.
+ :label FORM
+    FORM is an expression that is dynamically evaluated and whose
+    value serves as the menu item's label (the default is NAME).
 
-   :selected SELECTED
+ :suffix FORM
+    FORM is an expression that is dynamically evaluated and whose
+    value is concatenated with the menu entry's label.
 
-SELECTED is an expression; the checkbox or radio button is selected
-whenever this expression's value is non-nil.
+ :style STYLE
+    STYLE is a symbol describing the type of menu item; it should
+    be `toggle' (a checkbox), or `radio' (a radio button), or any
+    other value (meaning an ordinary menu item).
 
-   :help HELP
+ :selected SELECTED
+    SELECTED is an expression; the checkbox or radio button is
+    selected whenever the expression's value is non-nil.
 
-HELP is a string, the help to display for the menu item.
+ :help HELP
+    HELP is a string, the help to display for the menu item.
 
-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.
+Alternatively, a menu item can be a string.  Then that string
+appears in the menu as unselectable text.  A string consisting
+solely of dashes is displayed as a menu separator.
 
-A menu item can be a list with the same format as MENU.  This is a submenu."
-  (declare (indent defun))
+Alternatively, a menu item can be a list with the same format as
+MENU.  This is a submenu."
+  (declare (indent defun) (debug (symbolp body)))
   `(progn
      ,(if symbol `(defvar ,symbol nil ,doc))
      (easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu)))
@@ -236,14 +225,14 @@ possibly preceded by keyword pairs as described in `easy-menu-define'."
 		(keywordp (setq keyword (car menu-items))))
       (setq arg (cadr menu-items))
       (setq menu-items (cddr menu-items))
-      (case keyword
-       (:filter
+      (pcase keyword
+       (`:filter
 	(setq filter `(lambda (menu)
 			(easy-menu-filter-return (,arg menu) ,menu-name))))
-       ((:enable :active) (setq enable (or arg ''nil)))
-       (:label (setq label arg))
-       (:help (setq help arg))
-       ((:included :visible) (setq visible (or arg ''nil)))))
+       ((or `:enable `:active) (setq enable (or arg ''nil)))
+       (`:label (setq label arg))
+       (`:help (setq help arg))
+       ((or `:included `:visible) (setq visible (or arg ''nil)))))
     (if (equal visible ''nil)
 	nil				; Invisible menu entry, return nil.
       (if (and visible (not (easy-menu-always-true-p visible)))
@@ -334,16 +323,16 @@ ITEM defines an item as in `easy-menu-define'."
 		(setq keyword (aref item count))
 		(setq arg (aref item (1+ count)))
 		(setq count (+ 2 count))
-		(case keyword
-                  ((:included :visible) (setq visible (or arg ''nil)))
-                  (:key-sequence (setq cache arg cache-specified t))
-                  (:keys (setq keys arg no-name nil))
-                  (:label (setq label arg))
-                  ((:active :enable) (setq active (or arg ''nil)))
-                  (:help (setq prop (cons :help (cons arg prop))))
-                  (:suffix (setq suffix arg))
-                  (:style (setq style arg))
-                  (:selected (setq selected (or arg ''nil)))))
+		(pcase keyword
+                  ((or `:included `:visible) (setq visible (or arg ''nil)))
+                  (`:key-sequence (setq cache arg cache-specified t))
+                  (`:keys (setq keys arg no-name nil))
+                  (`:label (setq label arg))
+                  ((or `:active `:enable) (setq active (or arg ''nil)))
+                  (`:help (setq prop (cons :help (cons arg prop))))
+                  (`:suffix (setq suffix arg))
+                  (`:style (setq style arg))
+                  (`:selected (setq selected (or arg ''nil)))))
 	      (if suffix
 		  (setq label
 			(if (stringp suffix)
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index d7cfcfb870a..12311711fe0 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -1,6 +1,6 @@
-;;; edebug.el --- a source-level debugger for Emacs Lisp
+;;; edebug.el --- a source-level debugger for Emacs Lisp  -*- lexical-binding: t -*-
 
-;; Copyright (C) 1988-1995, 1997, 1999-2011  Free Software Foundation, Inc.
+;; Copyright (C) 1988-1995, 1997, 1999-2012 Free Software Foundation, Inc.
 
 ;; Author: Daniel LaLiberte <liberte@holonexus.org>
 ;; Maintainer: FSF
@@ -51,9 +51,8 @@
 
 ;;; Code:
 
-;;; Bug reporting
-
-(defalias 'edebug-submit-bug-report 'report-emacs-bug)
+(require 'macroexp)
+(eval-when-compile (require 'cl-lib))
 
 ;;; Options
 
@@ -191,6 +190,7 @@ Use this with caution since it is not debugged."
 
 (defcustom edebug-unwrap-results nil
   "Non-nil if Edebug should unwrap results of expressions.
+That is, Edebug will try to remove its own instrumentation from the result.
 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."
@@ -232,21 +232,18 @@ If the result is non-nil, then break.  Errors are ignored."
 
 ;;; Form spec utilities.
 
-(defmacro def-edebug-form-spec (symbol spec-form)
-  "For compatibility with old version."
-  (def-edebug-spec symbol (eval spec-form)))
-(make-obsolete 'def-edebug-form-spec 'def-edebug-spec "22.1")
-
 (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)))
+  (let ((spec nil)
+	(indirect symbol))
+    (while
+        (progn
+          (and (symbolp indirect)
+               (setq indirect
+                     (function-get indirect 'edebug-form-spec 'macro))))
       ;; (edebug-trace "indirection: %s" edebug-form-spec)
-      (setq edebug-form-spec indirect))
-    edebug-form-spec
-    ))
+      (setq spec indirect))
+    spec))
 
 ;;;###autoload
 (defun edebug-basic-spec (spec)
@@ -260,7 +257,7 @@ An extant spec symbol is a symbol that is not a function and has a
 	     (setq spec (cdr spec)))
 	   t))
 	((symbolp spec)
-	 (unless (functionp spec) (get spec 'edebug-form-spec)))))
+	 (unless (functionp spec) (function-get spec 'edebug-form-spec)))))
 
 ;;; Utilities
 
@@ -336,9 +333,7 @@ A lambda list keyword is a symbol that starts with `&'."
 	       (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.
+;; Not used.
 '(defmacro edebug-save-restriction (&rest body)
   "Evaluate BODY while saving the current buffers restriction.
 BODY may change buffer outside of current restriction, unlike
@@ -346,6 +341,7 @@ 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."
+  (declare (debug t))
   `(let ((edebug:s-r-beg (point-min-marker))
 	 (edebug:s-r-end (point-max-marker)))
      (unwind-protect
@@ -363,6 +359,7 @@ Return the result of the last expression in BODY."
   ;; Select WINDOW if it is provided and still exists.  Otherwise,
   ;; if buffer is currently shown in several windows, choose one.
   ;; Otherwise, find a new window, possibly splitting one.
+  ;; FIXME: We should probably just be using `pop-to-buffer'.
   (setq window
 	(cond
 	 ((and (edebug-window-live-p window)
@@ -371,10 +368,10 @@ Return the result of the last expression in BODY."
 	 ((eq (window-buffer (selected-window)) buffer)
 	  ;; Selected window already displays BUFFER.
 	  (selected-window))
-	 ((edebug-get-buffer-window buffer))
+	 ((get-buffer-window buffer 0))
 	 ((one-window-p 'nomini)
 	  ;; When there's one window only, split it.
-	  (split-window))
+	  (split-window (minibuffer-selected-window)))
 	 ((let ((trace-window (get-buffer-window edebug-trace-buffer)))
 	    (catch 'found
 	      (dolist (elt (window-list nil 'nomini))
@@ -385,13 +382,10 @@ Return the result of the last expression in BODY."
 		  (throw 'found elt))))))
 	 ;; All windows are dedicated or show `edebug-trace-buffer', split
 	 ;; selected one.
-	 (t (split-window))))
-  (select-window window)
+	 (t (split-window (minibuffer-selected-window)))))
   (set-window-buffer window buffer)
-  (set-window-hscroll window 0);; should this be??
-  ;; Selecting the window does not set the buffer until command loop.
-  ;;(set-buffer buffer)
-  )
+  (select-window window)
+  (set-window-hscroll window 0)) ;; should this be??
 
 (defun edebug-get-displayed-buffer-points ()
   ;; Return a list of buffer point pairs, for all displayed buffers.
@@ -444,18 +438,14 @@ Return the result of the last expression in BODY."
 	      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.
 
 ;; Save the original read function
-(or (fboundp 'edebug-original-read)
-    (defalias 'edebug-original-read  (symbol-function 'read)))
+(defalias 'edebug-original-read
+  (symbol-function (if (fboundp 'edebug-original-read)
+                       'edebug-original-read 'read)))
 
 (defun edebug-read (&optional stream)
   "Read one Lisp expression as text from STREAM, return as Lisp object.
@@ -526,6 +516,7 @@ the minibuffer."
            (setq face-new-frame-defaults
                  (assq-delete-all (nth 1 form) face-new-frame-defaults))
            (put (nth 1 form) 'face-defface-spec nil)
+           (put (nth 1 form) 'face-documentation (nth 3 form))
 	   ;; See comments in `eval-defun-1' for purpose of code below
 	   (setq form (prog1 `(prog1 ,form
 				(put ',(nth 1 form) 'saved-face
@@ -619,36 +610,29 @@ already is one.)"
 ;; 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)
-
-(defvar 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))
+(defvar-local edebug-form-data nil
+  "A list of entries associating symbols with buffer regions.
+Each entry is an `edebug--form-data' struct with fields:
+SYMBOL, BEGIN-MARKER, and END-MARKER.  The markers
+are at the beginning and end of an entry level form and SYMBOL is
+a symbol that holds all edebug related information for the form on its
+property list.
+
+In the future (haha!), the symbol will be irrelevant and edebug data will
+be stored in the definitions themselves rather than in the property
+list of a symbol.")
+
+(cl-defstruct (edebug--form-data
+               ;; Some callers expect accessors to return nil when passed nil.
+               (:type list)
+               (:constructor edebug--make-form-data-entry (name begin end))
+               (:predicate nil) (:constructor nil) (:copier nil))
+  name begin end)
 
 (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))
+  (setf (edebug--form-data-name entry) name) ;; In case name is changed.
+  (set-marker (edebug--form-data-begin entry) begin)
+  (set-marker (edebug--form-data-end entry) end))
 
 (defun edebug-get-form-data-entry (pnt &optional end-point)
   ;; Find the edebug form data entry which is closest to PNT.
@@ -656,17 +640,17 @@ already is one.)"
   ;; Return `nil' if none found.
   (let ((rest edebug-form-data)
 	closest-entry
-	(closest-dist 999999))  ;; need maxint here
+	(closest-dist 999999))  ;; Need maxint here.
     (while (and rest (< 0 closest-dist))
       (let* ((entry (car rest))
-	     (begin (edebug-form-data-begin entry))
+	     (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)))
+		     (= end-point (edebug--form-data-end entry)))
+		 (<= pnt (edebug--form-data-end entry)))
 	    (setq closest-dist dist
 		  closest-entry entry))))
     closest-entry))
@@ -675,19 +659,19 @@ already is one.)"
 ;; 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)))
+  "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)))
+  (push 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 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.
@@ -915,8 +899,7 @@ already is one.)"
   (cond ((eq ?\' (following-char))
 	 (forward-char 1)
 	 (list
-	  (edebug-storing-offsets (- (point) 2)
-	    (if (featurep 'cl) 'function* 'function))
+	  (edebug-storing-offsets (- (point) 2) 'function)
 	  (edebug-read-storing-offsets stream)))
 	((memq (following-char) '(?: ?B ?O ?X ?b ?o ?x ?1 ?2 ?3 ?4 ?5 ?6
 				  ?7 ?8 ?9 ?0))
@@ -1080,7 +1063,8 @@ already is one.)"
   ;; If it gets an error, make it nil.
   (let ((temp-hook edebug-setup-hook))
     (setq edebug-setup-hook nil)
-    (run-hooks 'temp-hook))
+    (if (functionp temp-hook) (funcall temp-hook)
+      (mapc #'funcall temp-hook)))
 
   (let (result
 	edebug-top-window-data
@@ -1217,8 +1201,8 @@ already is one.)"
 (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
+  ;; 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)
@@ -1231,13 +1215,11 @@ already is one.)"
   ;; given FORM.  Looks like:
   ;; (edebug-after (edebug-before BEFORE-INDEX) AFTER-INDEX FORM)
   ;; Also increment the offset index for subsequent use.
-  (list 'edebug-after
-	(list 'edebug-before before-index)
-	after-index form))
+  `(edebug-after (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))
+  `(edebug-after 0 ,after-index ,form))
 
 
 (defun edebug-unwrap (sexp)
@@ -1249,10 +1231,7 @@ expressions; a `progn' form will be returned enclosing these forms."
        ((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))))
+        (macroexp-progn (nthcdr 2 (nth 1 (nth 3 sexp)))))
        (t sexp);; otherwise it is not wrapped, so just return it.
        )
     sexp))
@@ -1290,7 +1269,7 @@ expressions; a `progn' form will be returned enclosing these forms."
 	 ;; Set this marker before parsing.
 	 (edebug-form-begin-marker
 	  (if form-data-entry
-	      (edebug-form-data-begin 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))))
 
@@ -1300,7 +1279,7 @@ expressions; a `progn' form will be returned enclosing these forms."
 	  ;; 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-old-def-name (edebug--form-data-name form-data-entry))
 	  edebug-def-name
 	  edebug-def-args
 	  edebug-def-interactive
@@ -1330,7 +1309,7 @@ expressions; a `progn' form will be returned enclosing these forms."
       ;; 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--make-form-data-entry
 		 edebug-def-name
 		 edebug-form-begin-marker
 		 ;; Buffer must be current-buffer.
@@ -1516,18 +1495,18 @@ expressions; a `progn' form will be returned enclosing these forms."
 ;; 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)
+(defun edebug-no-match (cursor &rest 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))
+	edebug-best-error (or edebug-best-error 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)))
+	(apply 'edebug-syntax-error args))
+    (throw 'no-match args)))
 
 
 (defun edebug-match (cursor specs)
@@ -1754,7 +1733,7 @@ expressions; a `progn' form will be returned enclosing these forms."
 		 specs))))
 
 
-(defun edebug-match-gate (cursor)
+(defun edebug-match-gate (_cursor)
   ;; Simply set the gate to prevent backtracking at this level.
   (setq edebug-gate t)
   nil)
@@ -1843,7 +1822,7 @@ expressions; a `progn' form will be returned enclosing these forms."
     nil))
 
 
-(defun edebug-match-function (cursor)
+(defun edebug-match-function (_cursor)
   (error "Use function-form instead of function in edebug spec"))
 
 (defun edebug-match-&define (cursor specs)
@@ -1900,7 +1879,7 @@ expressions; a `progn' form will be returned enclosing these forms."
     (edebug-move-cursor cursor)
     (list name)))
 
-(defun edebug-match-colon-name (cursor spec)
+(defun edebug-match-colon-name (_cursor spec)
   ;; Set the edebug-def-name to the spec.
   (setq edebug-def-name
 	(if edebug-def-name
@@ -1937,7 +1916,6 @@ expressions; a `progn' form will be returned enclosing these forms."
 
 ;;;; Edebug Form Specs
 ;;; ==========================================================
-;;; See cl-specs.el for common lisp specs.
 
 ;;;;* Spec for def-edebug-spec
 ;;; Out of date.
@@ -1986,6 +1964,8 @@ expressions; a `progn' form will be returned enclosing these forms."
 	   def-body))
 ;; FIXME? Isn't this missing the doc-string?  Cf defun.
 (def-edebug-spec defmacro
+  ;; FIXME: Improve `declare' so we can Edebug gv-expander and
+  ;; gv-setter declarations.
   (&define name lambda-list [&optional ("declare" &rest sexp)] def-body))
 
 (def-edebug-spec arglist lambda-list)  ;; deprecated - use lambda-list.
@@ -2010,25 +1990,17 @@ expressions; a `progn' form will be returned enclosing these forms."
 ;; 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))
 
-;; FIXME? The manual has a gate here.
+;; FIXME?  The manual uses this form (maybe that's just for illustration?):
+;; (def-edebug-spec let
+;;   ((&rest &or symbolp (gate symbolp &optional form))
+;;    body))
 (def-edebug-spec let
   ((&rest &or (symbolp &optional form) symbolp)
    body))
@@ -2089,49 +2061,12 @@ expressions; a `progn' form will be returned enclosing these forms."
 		     &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 delay-mode-hooks t)
-(def-edebug-spec with-temp-file t)
-(def-edebug-spec with-temp-message t)
-(def-edebug-spec with-syntax-table t)
-(def-edebug-spec push (form sexp))
-(def-edebug-spec pop (sexp))
-
-(def-edebug-spec 1value (form))
-(def-edebug-spec noreturn (form))
-
 
 ;; 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))
-
-(def-edebug-spec easy-menu-define (symbolp body))
-
-(def-edebug-spec with-custom-print body)
-
-
 ;;; The debugger itself
 
 (defvar edebug-active nil)  ;; Non-nil when edebug is active
@@ -2168,10 +2103,7 @@ expressions; a `progn' form will be returned enclosing these forms."
 
 ;; 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.
@@ -2187,8 +2119,6 @@ expressions; a `progn' form will be returned enclosing these forms."
 (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-overriding-local-map)
-(defvar edebug-outside-overriding-terminal-local-map)
 
 (defvar edebug-outside-pre-command-hook)
 (defvar edebug-outside-post-command-hook)
@@ -2197,7 +2127,7 @@ expressions; a `progn' form will be returned enclosing these forms."
 
 ;;; Handling signals
 
-(defun edebug-signal (edebug-signal-name edebug-signal-data)
+(defun edebug-signal (signal-name 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.
@@ -2211,19 +2141,18 @@ 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.
-\n(fn SIGNAL-NAME DATA)"
-  (if (and (listp debug-on-error) (memq edebug-signal-name debug-on-error))
-      (edebug 'error (cons edebug-signal-name edebug-signal-data)))
+error is signaled again."
+  (if (and (listp debug-on-error) (memq signal-name debug-on-error))
+      (edebug 'error (cons signal-name signal-data)))
   ;; If we reach here without another non-local exit, then send signal again.
   ;; i.e. the signal is not continuable, yet.
   ;; Avoid infinite recursion.
   (let ((signal-hook-function nil))
-    (signal edebug-signal-name edebug-signal-data)))
+    (signal signal-name signal-data)))
 
 ;;; Entering Edebug
 
-(defun edebug-enter (edebug-function edebug-args edebug-body)
+(defun edebug-enter (function args 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.
@@ -2232,83 +2161,51 @@ error is signaled again.
   ;; 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)
-
-	    (edebug-outside-overriding-local-map overriding-local-map)
-	    (edebug-outside-overriding-terminal-local-map
-	     overriding-terminal-local-map)
-
-	    ;; Save the outside value of executing macro.  (here??)
-	    (edebug-outside-executing-macro executing-kbd-macro)
-	    (edebug-outside-pre-command-hook
-	     (edebug-var-status 'pre-command-hook))
-	    (edebug-outside-post-command-hook
-	     (edebug-var-status '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))
-
-		  ;; Don't get confused by the user's keymap changes.
-		  (overriding-local-map nil)
-		  (overriding-terminal-local-map nil)
-
-		  (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)
-	  (edebug-restore-status
-	   'post-command-hook edebug-outside-post-command-hook)
-	  (edebug-restore-status
-	   'pre-command-hook edebug-outside-pre-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))
-      )))
+  (let ((edebug-function function))
+    (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))
+          (unwind-protect
+              (let ((signal-hook-function 'edebug-signal))
+                (setq edebug-execution-mode (or edebug-next-execution-mode
+                                                edebug-initial-mode
+                                                edebug-execution-mode)
+                      edebug-next-execution-mode nil)
+                (edebug-enter function args body))))
+
+      (let* ((edebug-data (get function 'edebug))
+             (edebug-def-mark (car edebug-data)) ; mark at def start
+             (edebug-freq-count (get function 'edebug-freq-count))
+             (edebug-coverage (get function 'edebug-coverage))
+             (edebug-buffer (marker-buffer edebug-def-mark))
+
+             (edebug-stack (cons function edebug-stack))
+             (edebug-offset-indices (cons 0 edebug-offset-indices))
+             )
+        (if (get function 'edebug-on-entry)
+            (progn
+              (setq edebug-execution-mode 'step)
+              (if (eq (get function 'edebug-on-entry) 'temp)
+                  (put function 'edebug-on-entry nil))))
+        (if edebug-trace
+            (edebug--enter-trace function args body)
+          (funcall body))
+        ))))
 
 (defun edebug-var-status (var)
   "Return a cons cell describing the status of VAR's current binding.
@@ -2335,14 +2232,14 @@ STATUS should be a list returned by `edebug-var-status'."
 	  (t
 	   (set var value)))))
 
-(defun edebug-enter-trace (edebug-body)
+(defun edebug--enter-trace (function args 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))
+     (format "%s args: %s" function args))
+    (prog1 (setq edebug-result (funcall body))
       (edebug-print-trace-after
-       (format "%s result: %s" edebug-function edebug-result)))))
+       (format "%s result: %s" function edebug-result)))))
 
 (def-edebug-spec edebug-tracing (form body))
 
@@ -2370,49 +2267,49 @@ MSG is printed after `::::} '."
 
 
 
-(defun edebug-slow-before (edebug-before-index)
+(defun edebug-slow-before (before-index)
   (unless edebug-active
     ;; 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)
+    (setcar edebug-offset-indices before-index)
 
     ;; Increment frequency count
-    (aset edebug-freq-count edebug-before-index
-	  (1+ (aref edebug-freq-count edebug-before-index)))
+    (aset edebug-freq-count before-index
+	  (1+ (aref edebug-freq-count 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)
+	    (input-pending-p))
+	(edebug-debugger before-index 'before nil)))
+  before-index)
 
-(defun edebug-fast-before (edebug-before-index)
+(defun edebug-fast-before (_before-index)
   ;; Do nothing.
   )
 
-(defun edebug-slow-after (edebug-before-index edebug-after-index edebug-value)
+(defun edebug-slow-after (_before-index after-index value)
   (if edebug-active
-      edebug-value
+      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)
+    (setcar edebug-offset-indices 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))
+    (aset edebug-freq-count after-index
+	  (1+ (aref edebug-freq-count after-index)))
+    (if edebug-test-coverage (edebug--update-coverage after-index value))
 
     (if (and (eq edebug-execution-mode 'Go-nonstop)
-	     (not (edebug-input-pending-p)))
+	     (not (input-pending-p)))
 	;; Just return result.
-	edebug-value
-      (edebug-debugger edebug-after-index 'after edebug-value)
+	value
+      (edebug-debugger after-index 'after value)
       )))
 
-(defun edebug-fast-after (edebug-before-index edebug-after-index edebug-value)
+(defun edebug-fast-after (_before-index _after-index value)
   ;; Do nothing but return the value.
-  edebug-value)
+  value)
 
 (defun edebug-run-slow ()
   (defalias 'edebug-before 'edebug-slow-before)
@@ -2426,19 +2323,18 @@ MSG is printed after `::::} '."
 (edebug-run-slow)
 
 
-(defun edebug-update-coverage ()
-  (let ((old-result (aref edebug-coverage edebug-after-index)))
+(defun edebug--update-coverage (after-index value)
+  (let ((old-result (aref edebug-coverage after-index)))
     (cond
      ((eq 'ok-coverage old-result))
      ((eq 'unknown old-result)
-      (aset edebug-coverage edebug-after-index edebug-value))
+      (aset edebug-coverage after-index value))
      ;; Test if a different result.
-     ((not (eq edebug-value old-result))
-      (aset edebug-coverage edebug-after-index 'ok-coverage)))))
+     ((not (eq value old-result))
+      (aset edebug-coverage 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.
@@ -2449,16 +2345,16 @@ MSG is printed after `::::} '."
 (defvar edebug-global-break-result nil)
 
 
-(defun edebug-debugger (edebug-offset-index edebug-arg-mode edebug-value)
+(defun edebug-debugger (offset-index arg-mode value)
   (if inhibit-redisplay
       ;; Don't really try to enter edebug within an eval from redisplay.
-      edebug-value
+      value
     ;; Check breakpoints and pending input.
-    ;; If edebug display should be updated, call edebug-display.
-    ;; Return edebug-value.
+    ;; If edebug display should be updated, call edebug--display.
+    ;; Return 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-data (assq offset-index edebug-breakpoints))
 	   (edebug-break-condition (car (cdr edebug-break-data)))
 	   (edebug-global-break
 	    (if edebug-global-break-condition
@@ -2469,7 +2365,7 @@ MSG is printed after `::::} '."
 		  (error nil))))
 	   (edebug-break))
 
-;;;    (edebug-trace "exp: %s" edebug-value)
+      ;;(edebug-trace "exp: %s" value)
       ;; Test whether we should break.
       (setq edebug-break
 	    (or edebug-global-break
@@ -2489,11 +2385,10 @@ MSG is printed after `::::} '."
       ;; 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
+	      (input-pending-p))
+	  (edebug--display value offset-index arg-mode)) ; <---------- display
 
-      edebug-value
-      )))
+      value)))
 
 
 ;; window-start now stored with each function.
@@ -2525,8 +2420,9 @@ MSG is printed after `::::} '."
 ;; Emacs 19 adds an arg to mark and mark-marker.
 (defalias 'edebug-mark-marker 'mark-marker)
 
+(defvar edebug-outside-unread-command-events)
 
-(defun edebug-display ()
+(defun edebug--display (value offset-index arg-mode)
   (unless (marker-position edebug-def-mark)
     ;; The buffer holding the source has been killed.
     ;; Let's at least show a backtrace so the user can figure out
@@ -2535,11 +2431,11 @@ MSG is printed after `::::} '."
   ;; 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
+  (let ((edebug-active t)		; For minor mode alist.
 	(edebug-with-timeout-suspend (with-timeout-suspend))
-	edebug-stop			; should we enter recursive-edit
+	edebug-stop			; Should we enter recursive-edit?
 	(edebug-point (+ edebug-def-mark
-			 (aref (nth 2 edebug-data) edebug-offset-index)))
+			 (aref (nth 2 edebug-data) offset-index)))
 	edebug-buffer-outside-point     ; current point in edebug-buffer
 	;; window displaying edebug-buffer
 	(edebug-window-data (nth 3 edebug-data))
@@ -2548,12 +2444,12 @@ MSG is printed after `::::} '."
 	(edebug-outside-point (point))
  	(edebug-outside-mark (edebug-mark))
 	(edebug-outside-unread-command-events unread-command-events)
-	edebug-outside-windows		; window or screen configuration
+	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-eval-buffer             ; Declared here so we can kill it below.
+	(eval-result-list (and edebug-eval-list
+                               (edebug-eval-result-list)))
 	edebug-trace-window
 	edebug-trace-window-start
 
@@ -2566,7 +2462,7 @@ MSG is printed after `::::} '."
 	(let ((overlay-arrow-position overlay-arrow-position)
 	      (overlay-arrow-string overlay-arrow-string)
 	      (cursor-in-echo-area nil)
-	      (unread-command-events unread-command-events)
+	      (unread-command-events nil)
 	      ;; any others??
 	      )
           (setq-default cursor-in-non-selected-windows t)
@@ -2574,9 +2470,9 @@ MSG is printed after `::::} '."
 	      (let ((debug-on-error nil))
 		(error "Buffer defining %s not found" edebug-function)))
 
-	  (if (eq 'after edebug-arg-mode)
+	  (if (eq 'after arg-mode)
 	      ;; Compute result string now before windows are modified.
-	      (edebug-compute-previous-result edebug-value))
+	      (edebug-compute-previous-result value))
 
 	  (if edebug-save-windows
 	      ;; Save windows now before we modify them.
@@ -2600,7 +2496,7 @@ MSG is printed after `::::} '."
 	  ;; 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)
+	  (edebug-eval-display eval-result-list)
 	  ;; The evaluation list better not have deleted edebug-window-data.
 	  (select-window (car edebug-window-data))
 	  (set-buffer edebug-buffer)
@@ -2608,7 +2504,7 @@ MSG is printed after `::::} '."
 	  (setq edebug-buffer-outside-point (point))
 	  (goto-char edebug-point)
 
-	  (if (eq 'before edebug-arg-mode)
+	  (if (eq 'before arg-mode)
 	      ;; Check whether positions are up-to-date.
 	      ;; This assumes point is never before symbol.
 	      (if (not (memq (following-char) '(?\( ?\# ?\` )))
@@ -2621,7 +2517,7 @@ MSG is printed after `::::} '."
 		  (edebug-adjust-window (cdr edebug-window-data)))
 
 	  ;; Test if there is input, not including keyboard macros.
-	  (if (edebug-input-pending-p)
+	  (if (input-pending-p)
 	      (progn
 		(setq edebug-execution-mode 'step
 		      edebug-stop t)
@@ -2632,14 +2528,14 @@ MSG is printed after `::::} '."
 	  (edebug-overlay-arrow)
 
 	  (cond
-	   ((eq 'error edebug-arg-mode)
+	   ((eq 'error arg-mode)
 	    ;; Display error message
 	    (setq edebug-execution-mode 'step)
 	    (edebug-overlay-arrow)
 	    (beep)
-	    (if (eq 'quit (car edebug-value))
+	    (if (eq 'quit (car value))
 		(message "Quit")
-	      (edebug-report-error edebug-value)))
+	      (edebug-report-error value)))
 	   (edebug-break
 	    (cond
 	     (edebug-global-break
@@ -2656,41 +2552,40 @@ MSG is printed after `::::} '."
 
 	   (t (message "")))
 
-	  (setq unread-command-events nil)
-	  (if (eq 'after edebug-arg-mode)
+	  (if (eq 'after arg-mode)
 	      (progn
 		;; Display result of previous evaluation.
 		(if (and edebug-break
 			 (not (eq edebug-execution-mode 'Continue-fast)))
-                    (edebug-sit-for edebug-sit-for-seconds)) ; Show message.
+                    (sit-for edebug-sit-for-seconds)) ; Show message.
 		(edebug-previous-result)))
 
 	  (cond
 	   (edebug-break
 	    (cond
 	     ((eq edebug-execution-mode 'continue)
-              (edebug-sit-for edebug-sit-for-seconds))
-	     ((eq edebug-execution-mode 'Continue-fast) (edebug-sit-for 0))
+              (sit-for edebug-sit-for-seconds))
+	     ((eq edebug-execution-mode 'Continue-fast) (sit-for 0))
 	     (t (setq edebug-stop t))))
 	   ;; not edebug-break
 	   ((eq edebug-execution-mode 'trace)
-	    (edebug-sit-for edebug-sit-for-seconds)) ; Force update and pause.
+	    (sit-for edebug-sit-for-seconds)) ; Force update and pause.
 	   ((eq edebug-execution-mode 'Trace-fast)
-	    (edebug-sit-for 0)))		; Force update and continue.
+	    (sit-for 0)))		; Force update and continue.
 
 	  (unwind-protect
 	      (if (or edebug-stop
 		      (memq edebug-execution-mode '(step next))
-		      (eq edebug-arg-mode 'error))
+		      (eq arg-mode 'error))
 		  (progn
 		    ;; (setq edebug-execution-mode 'step)
 		    ;; (edebug-overlay-arrow)	; This doesn't always show up.
-		    (edebug-recursive-edit))) ; <---------- Recursive edit
+		    (edebug--recursive-edit arg-mode))) ; <----- 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))))
+			    (get-buffer-window edebug-buffer))))
 	      ;; Remember window-start for edebug-buffer, if still displayed.
 	      (if window
 		  (progn
@@ -2768,6 +2663,8 @@ MSG is printed after `::::} '."
 	    (goto-char edebug-buffer-outside-point))
 	  ;; ... nothing more.
 	  )
+      ;; Could be an option to keep eval display up.
+      (if edebug-eval-buffer (kill-buffer edebug-eval-buffer))
       (with-timeout-unsuspend edebug-with-timeout-suspend)
       ;; Reset global variables to outside values in case they were changed.
       (setq
@@ -2805,26 +2702,15 @@ MSG is printed after `::::} '."
 ;; in versions where the variable is *not* built-in.
 
 ;; Emacs 18  FIXME
-(defvar edebug-outside-unread-command-char)
 
 ;; 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			; FIXME
-  (setq edebug-unread-command-char-warning
-	(get 'unread-command-char 'byte-obsolete-variable))
-  (put 'unread-command-char 'byte-obsolete-variable nil))
-
-(defun edebug-recursive-edit ()
+(defun edebug--recursive-edit (arg-mode)
   ;; 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.
@@ -2845,14 +2731,20 @@ MSG is printed after `::::} '."
 
 	(edebug-outside-map (current-local-map))
 
-	(edebug-outside-standard-output standard-output)
+        ;; Save the outside value of executing macro.  (here??)
+        (edebug-outside-executing-macro executing-kbd-macro)
+        (edebug-outside-pre-command-hook
+         (edebug-var-status 'pre-command-hook))
+        (edebug-outside-post-command-hook
+         (edebug-var-status 'post-command-hook))
+
+        (edebug-outside-standard-output standard-output)
 	(edebug-outside-standard-input standard-input)
 	(edebug-outside-defining-kbd-macro defining-kbd-macro)
 
 	(edebug-outside-last-command last-command)
 	(edebug-outside-this-command this-command)
 
-	(edebug-outside-unread-command-char unread-command-char) ; FIXME
 	(edebug-outside-current-prefix-arg current-prefix-arg)
 
 	(edebug-outside-last-input-event last-input-event)
@@ -2868,9 +2760,6 @@ MSG is printed after `::::} '."
 	      ;; We could set these to the values for previous edebug call.
 	      (last-command last-command)
 	      (this-command this-command)
-
-	      ;; Assume no edebug command sets unread-command-char.
-	      (unread-command-char -1)
 	      (current-prefix-arg nil)
 
 	      ;; More for Emacs 19
@@ -2880,7 +2769,20 @@ MSG is printed after `::::} '."
 	      (last-nonmenu-event nil)
 	      (track-mouse nil)
 
-	      ;; Bind again to outside values.
+              (standard-output t)
+              (standard-input t)
+
+	      ;; 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))
+
+              ;; Don't get confused by the user's keymap changes.
+              (overriding-local-map nil)
+              (overriding-terminal-local-map nil)
+
+		  ;; Bind again to outside values.
 	      (debug-on-error edebug-outside-debug-on-error)
 	      (debug-on-quit edebug-outside-debug-on-quit)
 
@@ -2888,11 +2790,17 @@ MSG is printed after `::::} '."
 	      (defining-kbd-macro
 		(if edebug-continue-kbd-macro defining-kbd-macro))
 
+	      ;; 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)
+
 	      ;; others??
 	      )
 
 	  (if (and (eq edebug-execution-mode 'go)
-		   (not (memq edebug-arg-mode '(after error))))
+		   (not (memq arg-mode '(after error))))
 	      (message "Break"))
 
 	  (setq buffer-read-only t)
@@ -2906,8 +2814,6 @@ MSG is printed after `::::} '."
 	    (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))
@@ -2934,7 +2840,6 @@ MSG is printed after `::::} '."
        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
        current-prefix-arg edebug-outside-current-prefix-arg
        last-input-event edebug-outside-last-input-event
        last-event-frame edebug-outside-last-event-frame
@@ -2943,17 +2848,21 @@ MSG is printed after `::::} '."
 
        standard-output edebug-outside-standard-output
        standard-input edebug-outside-standard-input
-       defining-kbd-macro edebug-outside-defining-kbd-macro
-       ))
-    ))
+       defining-kbd-macro edebug-outside-defining-kbd-macro)
+
+      (setq executing-kbd-macro edebug-outside-executing-macro)
+      (edebug-restore-status
+       'post-command-hook edebug-outside-post-command-hook)
+      (edebug-restore-status
+       'pre-command-hook edebug-outside-pre-command-hook))))
 
 
 ;;; 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)
+  ;; (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
@@ -2961,7 +2870,7 @@ MSG is printed after `::::} '."
 	    (set-window-start (selected-window) old-start))
 	(if (not (pos-visible-in-window-p))
 	    (progn
-;;	(message "resetting window start") (sit-for 2)
+	;; (message "resetting window start") (sit-for 2)
 	(set-window-start
 	 (selected-window)
 	 (save-excursion
@@ -3058,7 +2967,6 @@ Otherwise, toggle for all windows."
       (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)
@@ -3101,12 +3009,12 @@ before returning.  The default is one second."
 	       (current-buffer) (point)
 	       (if (marker-buffer (edebug-mark-marker))
 		   (marker-position (edebug-mark-marker)) "<not set>"))
-      (edebug-sit-for arg)
+      (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.
+;; 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.")
@@ -3428,7 +3336,7 @@ function or macro is called, Edebug will be called there as well."
 	   (save-excursion
 	     (down-list 1)
 	     (if (looking-at "\(")
-		 (edebug-form-data-name
+		 (edebug--form-data-name
 		  (edebug-get-form-data-entry (point)))
 	       (edebug-original-read (current-buffer))))))
       (edebug-instrument-function func))))
@@ -3541,11 +3449,10 @@ edebug-mode."
 
 ;;; 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."
+  (declare (debug t))
   `(save-excursion			; of current-buffer
      (if edebug-save-windows
 	 (progn
@@ -3564,7 +3471,6 @@ Return the result of the last expression."
 	   (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-events edebug-outside-unread-command-events)
 	   (current-prefix-arg edebug-outside-current-prefix-arg)
 	   (last-input-event edebug-outside-last-input-event)
@@ -3580,7 +3486,7 @@ Return the result of the last expression."
 	   (pre-command-hook (cdr edebug-outside-pre-command-hook))
 	   (post-command-hook (cdr edebug-outside-post-command-hook))
 
-	   ;; See edebug-display
+	   ;; 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)
@@ -3604,7 +3510,6 @@ Return the result of the last expression."
 	  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-events unread-command-events
 	  edebug-outside-current-prefix-arg current-prefix-arg
 	  edebug-outside-last-input-event last-input-event
@@ -3635,18 +3540,19 @@ Return the result of the last expression."
 
 (defvar cl-debug-env)  ; defined in cl; non-nil when lexical env used.
 
-(defun edebug-eval (edebug-expr)
+(defun edebug-eval (expr)
   ;; Are there cl lexical variables active?
-  (eval (if (bound-and-true-p cl-debug-env)
-            (cl-macroexpand-all edebug-expr cl-debug-env)
-          edebug-expr)
+  (eval (if (and (bound-and-true-p cl-debug-env)
+                 (fboundp 'cl-macroexpand-all))
+            (cl-macroexpand-all expr cl-debug-env)
+          expr)
         lexical-binding))
 
-(defun edebug-safe-eval (edebug-expr)
+(defun edebug-safe-eval (expr)
   ;; Evaluate EXPR safely.
   ;; If there is an error, a string is returned describing the error.
   (condition-case edebug-err
-      (edebug-eval edebug-expr)
+      (edebug-eval expr)
     (error (edebug-format "%s: %s"  ;; could
 			  (get (car edebug-err) 'error-message)
 			  (car (cdr edebug-err))))))
@@ -3654,17 +3560,17 @@ Return the result of the last expression."
 ;;; Printing
 
 
-(defun edebug-report-error (edebug-value)
+(defun edebug-report-error (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)))
+	   (or (get (car value) 'error-message)
+	       (format "peculiar error (%s)" (car value)))
 	   (mapconcat (function (lambda (edebug-arg)
 				  ;; continuing after an error may
 				  ;; complain about edebug-arg. why??
 				  (prin1-to-string edebug-arg)))
-		      (cdr edebug-value) ", ")))
+		      (cdr value) ", ")))
 
 (defvar print-readably) ; defined by lemacs
 ;; Alternatively, we could change the definition of
@@ -3680,14 +3586,14 @@ Return the result of the last expression."
 	(edebug-prin1-to-string value)
       (error "#Apparently circular structure#"))))
 
-(defun edebug-compute-previous-result (edebug-previous-value)
+(defun edebug-compute-previous-result (previous-value)
   (if edebug-unwrap-results
-      (setq edebug-previous-value
-	    (edebug-unwrap* edebug-previous-value)))
+      (setq previous-value
+	    (edebug-unwrap* previous-value)))
   (setq edebug-previous-result
 	(concat "Result: "
-		(edebug-safe-prin1-to-string edebug-previous-value)
-		(eval-expression-print-format edebug-previous-value))))
+		(edebug-safe-prin1-to-string previous-value)
+		(eval-expression-print-format previous-value))))
 
 (defun edebug-previous-result ()
   "Print the previous result."
@@ -3702,7 +3608,7 @@ Return the result of the last expression."
 (defalias 'edebug-format 'format)
 (defalias 'edebug-message 'message)
 
-(defun edebug-eval-expression (edebug-expr)
+(defun edebug-eval-expression (expr)
   "Evaluate an expression in the outside environment.
 If interactive, prompt for the expression.
 Print result in minibuffer."
@@ -3711,7 +3617,7 @@ Print result in minibuffer."
 		      'read-expression-history)))
   (princ
    (edebug-outside-excursion
-    (setq values (cons (edebug-eval edebug-expr) values))
+    (setq values (cons (edebug-eval expr) values))
     (concat (edebug-safe-prin1-to-string (car values))
             (eval-expression-print-format (car values))))))
 
@@ -3725,25 +3631,29 @@ Print value in minibuffer."
   "Evaluate sexp before point in outside environment; insert value.
 This prints the value into current buffer."
   (interactive)
-  (let* ((edebug-form (edebug-last-sexp))
-	 (edebug-result-string
+  (let* ((form (edebug-last-sexp))
+	 (result-string
 	  (edebug-outside-excursion
-	   (edebug-safe-prin1-to-string (edebug-safe-eval edebug-form))))
+	   (edebug-safe-prin1-to-string (edebug-safe-eval form))))
 	 (standard-output (current-buffer)))
     (princ "\n")
     ;; princ the string to get rid of quotes.
-    (princ edebug-result-string)
+    (princ result-string)
     (princ "\n")
     ))
 
 ;;; Edebug Minor Mode
 
-;; FIXME eh?
-(defvar gud-inhibit-global-bindings
-  "*Non-nil means don't do global rebindings of C-x C-a subcommands.")
+(defvar edebug-inhibit-emacs-lisp-mode-bindings nil
+  "If non-nil, inhibit Edebug bindings on the C-x C-a key.
+By default, loading the `edebug' library causes these bindings to
+be installed in `emacs-lisp-mode-map'.")
+
+(define-obsolete-variable-alias 'gud-inhibit-global-bindings
+  'edebug-inhibit-emacs-lisp-mode-bindings "24.3")
 
 ;; Global GUD bindings for all emacs-lisp-mode buffers.
-(unless gud-inhibit-global-bindings
+(unless edebug-inhibit-emacs-lisp-mode-bindings
   (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)
@@ -3920,44 +3830,38 @@ Options:
 	(edebug-trace nil))
     (mapcar 'edebug-safe-eval edebug-eval-list)))
 
-(defun edebug-eval-display-list (edebug-eval-result-list)
+(defun edebug-eval-display-list (eval-result-list)
   ;; Assumes edebug-eval-buffer exists.
-  (let ((edebug-eval-list-temp edebug-eval-list)
-	(standard-output edebug-eval-buffer)
+  (let ((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)))
+    (dolist (exp edebug-eval-list)
+      (prin1 exp) (terpri)
+      (prin1 (pop eval-result-list)) (terpri)
+      (princ edebug-comment-line))
     (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))))
+  (unless (and edebug-eval-buffer (buffer-name edebug-eval-buffer))
+    (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 EDEBUG-EVAL-RESULT-LIST.
+(defun edebug-eval-display (eval-result-list)
+  "Display expressions and evaluations in EVAL-RESULT-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)
-	)))
+  (when eval-result-list
+    (edebug-create-eval-buffer)
+    (edebug-eval-display-list eval-result-list)))
 
 (defun edebug-eval-redisplay ()
   "Redisplay eval list in outside environment.
-May only be called from within `edebug-recursive-edit'."
+May only be called from within `edebug--recursive-edit'."
   (edebug-create-eval-buffer)
   (edebug-outside-excursion
    (edebug-eval-display-list (edebug-eval-result-list))
@@ -3981,7 +3885,7 @@ May only be called from within `edebug-recursive-edit'."
     (if (not (eobp))
 	(progn
 	  (forward-sexp 1)
-	  (setq new-list (cons (edebug-last-sexp) new-list))))
+	  (push (edebug-last-sexp) new-list)))
 
     (while (re-search-forward "^;" nil t)
       (forward-line 1)
@@ -3990,7 +3894,7 @@ May only be called from within `edebug-recursive-edit'."
 	       (not (eobp)))
 	  (progn
 	    (forward-sexp 1)
-	    (setq new-list (cons (edebug-last-sexp) new-list)))))
+	    (push (edebug-last-sexp) new-list))))
 
     (setq edebug-eval-list (nreverse new-list))
     (edebug-eval-redisplay)
@@ -4019,8 +3923,8 @@ May only be called from within `edebug-recursive-edit'."
     (define-key map "\C-c\C-u" 'edebug-update-eval-list)
     (define-key map "\C-x\C-e" 'edebug-eval-last-sexp)
     (define-key map "\C-j" 'edebug-eval-print-last-sexp)
-  map)
-"Keymap for Edebug Eval mode.  Superset of Lisp Interaction mode.")
+    map)
+  "Keymap for Edebug Eval mode.  Superset of Lisp Interaction mode.")
 
 (put 'edebug-eval-mode 'mode-class 'special)
 
@@ -4047,32 +3951,32 @@ Global commands prefixed by `global-edebug-prefix':
 ;; 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)
+(defun edebug (&optional arg-mode &rest 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)
+  ;;(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))
+	    (offset-index (car edebug-offset-indices))
+	    (value (car args))
+	    ;; Bind variables required by edebug--display.
 	    edebug-breakpoints
 	    edebug-break-data
 	    edebug-break-condition
 	    edebug-global-break
-	    (edebug-break (null edebug-arg-mode)) ;; if called explicitly
+	    (edebug-break (null arg-mode)) ;; If called explicitly.
 	    )
-	(edebug-display)
-	(if (eq edebug-arg-mode 'error)
+	(edebug--display value offset-index arg-mode)
+	(if (eq arg-mode 'error)
 	    nil
-	  edebug-value))
+	  value))
 
     ;; Otherwise call debug normally.
     ;; Still need to remove extraneous edebug calls from stack.
-    (apply 'debug edebug-arg-mode debugger-args)
+    (apply 'debug arg-mode args)
     ))
 
 
@@ -4083,7 +3987,7 @@ Otherwise call `debug' normally."
 	  (null (buffer-name edebug-backtrace-buffer)))
       (setq edebug-backtrace-buffer
 	    (generate-new-buffer "*Backtrace*"))
-    ;; else, could just display edebug-backtrace-buffer
+    ;; Else, could just display edebug-backtrace-buffer.
     )
   (with-output-to-temp-buffer (buffer-name edebug-backtrace-buffer)
     (setq edebug-backtrace-buffer standard-output)
@@ -4105,7 +4009,7 @@ Otherwise call `debug' normally."
 	(beginning-of-line)
 	(cond
 	 ((looking-at "^  \(edebug-after")
-	  ;; Previous lines may contain code, so just delete this line
+	  ;; Previous lines may contain code, so just delete this line.
 	  (setq last-ok-point (point))
 	  (forward-line 1)
 	  (delete-region last-ok-point (point)))
@@ -4123,15 +4027,15 @@ Otherwise call `debug' normally."
   "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))
+  ;; 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)
+    ;; (message "before pop-to-buffer") (sit-for 1)
     (edebug-pop-to-buffer buffer)
     (setq truncate-lines t)
     (setq buf-window (selected-window))
@@ -4141,8 +4045,8 @@ You must include newlines in FMT to break lines, but one newline is appended."
     (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)
+    ;; (set-window-point buf-window (point))
+    ;; (sit-for 0)
     (bury-buffer buffer)
     (select-window selected-window)
     (set-buffer oldbuf))
@@ -4157,6 +4061,8 @@ You must include newlines in FMT to break lines, but one newline is appended."
 ;;; Frequency count and coverage
 
 ;; FIXME should this use overlays instead?
+;; Definitely, IMO.  The current business with undo in
+;; edebug-temp-display-freq-count is horrid.
 (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,
@@ -4203,8 +4109,8 @@ reinstrument it."
 	;; 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.
+	      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)
@@ -4226,6 +4132,8 @@ reinstrument it."
 	(insert "\n")
 	(setq i first-index)))))
 
+;; FIXME this does not work very well.  Eg if you press an arrow key,
+;; or make a mouse-click, it fails with "Non-character input-event".
 (defun edebug-temp-display-freq-count ()
   "Temporarily display the frequency count data for the current definition.
 It is removed when you hit any char."
@@ -4234,7 +4142,9 @@ It is removed when you hit any char."
   (let ((buffer-read-only nil))
     (undo-boundary)
     (edebug-display-freq-count)
-    (setq unread-command-char (read-char))
+    (setq unread-command-events
+          (append unread-command-events (list (read-event))))
+    ;; Yuck!  This doesn't seem to work at all for me.
     (undo)))
 
 
@@ -4345,96 +4255,8 @@ With prefix argument, make it a temporary breakpoint."
 
 (easy-menu-define edebug-menu edebug-mode-map "Edebug menus" edebug-mode-menus)
 
-;;; 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)))
-
-(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."
-    (mapc
-     (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
@@ -4446,6 +4268,21 @@ With prefix argument, make it a temporary breakpoint."
 
 ;;; Finalize Loading
 
+;; When edebugging a function, some of the sub-expressions are
+;; wrapped in (edebug-enter (lambda () ..)), so we need to teach
+;; called-interactively-p that calls within the inner lambda should refer to
+;; the outside function.
+(add-hook 'called-interactively-p-functions
+          #'edebug--called-interactively-skip)
+(defun edebug--called-interactively-skip (i frame1 frame2)
+  (when (and (eq (car-safe (nth 1 frame1)) 'lambda)
+             (eq (nth 1 (nth 1 frame1)) '())
+             (eq (nth 1 frame2) 'edebug-enter))
+    ;; `edebug-enter' calls itself on its first invocation.
+    (if (eq (nth 1 (internal--called-interactively-p--get-frame i))
+            'edebug-enter)
+        2 1)))
+
 ;; Finally, hook edebug into the rest of Emacs.
 ;; There are probably some other things that could go here.
 
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index 278dff0f085..69fe762887f 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -1,10 +1,9 @@
 ;;; eieio-base.el --- Base classes for EIEIO.
 
-;;; Copyright (C) 2000-2002, 2004-2005, 2007-2011
+;;; Copyright (C) 2000-2002, 2004-2005, 2007-2012
 ;;; Free Software Foundation, Inc.
 
 ;; Author: Eric M. Ludlam  <zappo@gnu.org>
-;; Version: 0.2
 ;; Keywords: OO, lisp
 ;; Package: eieio
 
@@ -225,8 +224,16 @@ a file.  Optional argument NAME specifies a default file name."
 			      ))))
   (oref this file))
 
-(defun eieio-persistent-read (filename)
-  "Read a persistent object from FILENAME, and return it."
+(defun eieio-persistent-read (filename &optional class allow-subclass)
+  "Read a persistent object from FILENAME, and return it.
+Signal an error if the object in FILENAME is not a constructor
+for CLASS.  Optional ALLOW-SUBCLASS says that it is ok for
+`eieio-persistent-read' to load in subclasses of class instead of
+being pedantic."
+  (unless class
+    (message "Unsafe call to `eieio-persistent-read'."))
+  (when (and class (not (class-p class)))
+    (signal 'wrong-type-argument (list 'class-p class)))
   (let ((ret nil)
 	(buffstr nil))
     (unwind-protect
@@ -239,13 +246,171 @@ a file.  Optional argument NAME specifies a default file name."
 	  ;; so that any initialize-instance calls that depend on
 	  ;; the current buffer will work.
 	  (setq ret (read buffstr))
-	  (if (not (child-of-class-p (car ret) 'eieio-persistent))
-	      (error "Corrupt object on disk"))
-	  (setq ret (eval ret))
+	  (when (not (child-of-class-p (car ret) 'eieio-persistent))
+	    (error "Corrupt object on disk: Unknown saved object"))
+	  (when (and class
+		     (not (or (eq (car ret) class ) ; same class
+			      (and allow-subclass
+				   (child-of-class-p (car ret) class)) ; subclasses
+			      )))
+	    (error "Corrupt object on disk: Invalid saved class"))
+	  (setq ret (eieio-persistent-convert-list-to-object ret))
 	  (oset ret file filename))
       (kill-buffer " *tmp eieio read*"))
     ret))
 
+(defun eieio-persistent-convert-list-to-object (inputlist)
+  "Convert the INPUTLIST, representing object creation to an object.
+While it is possible to just `eval' the INPUTLIST, this code instead
+validates the existing list, and explicitly creates objects instead of
+calling eval.  This avoids the possibility of accidentally running
+malicious code.
+
+Note: This function recurses when a slot of :type of some object is
+identified, and needing more object creation."
+  (let ((objclass (nth 0 inputlist))
+	(objname (nth 1 inputlist))
+	(slots (nthcdr 2 inputlist))
+	(createslots nil))
+
+    ;; If OBJCLASS is an eieio autoload object, then we need to load it.
+    (eieio-class-un-autoload objclass)
+
+    (while slots
+      (let ((name (car slots))
+	    (value (car (cdr slots))))
+
+	;; Make sure that the value proposed for SLOT is valid.
+	;; In addition, strip out quotes, list functions, and update
+	;; object constructors as needed.
+	(setq value (eieio-persistent-validate/fix-slot-value
+		     objclass name value))
+
+	(push name createslots)
+	(push value createslots)
+	)
+
+      (setq slots (cdr (cdr slots))))
+
+    (apply 'make-instance objclass objname (nreverse createslots))
+
+    ;;(eval inputlist)
+    ))
+
+(defun eieio-persistent-validate/fix-slot-value (class slot proposed-value)
+  "Validate that in CLASS, the SLOT with PROPOSED-VALUE is good, then fix.
+A limited number of functions, such as quote, list, and valid object
+constructor functions are considered valid.
+Second, any text properties will be stripped from strings."
+  (cond ((consp proposed-value)
+	 ;; Lists with something in them need special treatment.
+	 (let ((slot-idx (eieio-slot-name-index class nil slot))
+	       (type nil)
+	       (classtype nil))
+	   (setq slot-idx (- slot-idx 3))
+	   (setq type (aref (aref (class-v class) class-public-type)
+			    slot-idx))
+
+	   (setq classtype (eieio-persistent-slot-type-is-class-p
+			    type))
+
+	   (cond ((eq (car proposed-value) 'quote)
+		  (car (cdr proposed-value)))
+
+		 ;; An empty list sometimes shows up as (list), which is dumb, but
+		 ;; we need to support it for backward compat.
+		 ((and (eq (car proposed-value) 'list)
+		       (= (length proposed-value) 1))
+		  nil)
+
+		  ;; We have a slot with a single object that can be
+		  ;; saved here.  Recurse and evaluate that
+		  ;; sub-object.
+		 ((and classtype (class-p classtype)
+		       (child-of-class-p (car proposed-value) classtype))
+		  (eieio-persistent-convert-list-to-object
+		   proposed-value))
+
+		 ;; List of object constructors.
+		 ((and (eq (car proposed-value) 'list)
+		       ;; 2nd item is a list.
+		       (consp (car (cdr proposed-value)))
+		       ;; 1st elt of 2nd item is a class name.
+		       (class-p (car (car (cdr proposed-value))))
+		       )
+
+		  ;; Check the value against the input class type.
+		  ;; If something goes wrong, issue a smart warning
+		  ;; about how a :type is needed for this to work.
+		  (unless (and
+			   ;; Do we have a type?
+			   (consp classtype) (class-p (car classtype)))
+		    (error "In save file, list of object constructors found, but no :type specified for slot %S"
+			   slot))
+
+		  ;; We have a predicate, but it doesn't satisfy the predicate?
+		  (dolist (PV (cdr proposed-value))
+		    (unless (child-of-class-p (car PV) (car classtype))
+		      (error "Corrupt object on disk")))
+
+		  ;; We have a list of objects here.  Lets load them
+		  ;; in.
+		  (let ((objlist nil))
+		    (dolist (subobj (cdr proposed-value))
+		      (push (eieio-persistent-convert-list-to-object subobj)
+			    objlist))
+		    ;; return the list of objects ... reversed.
+		    (nreverse objlist)))
+		 (t
+		  proposed-value))))
+
+	 ((stringp proposed-value)
+	  ;; Else, check for strings, remove properties.
+	  (substring-no-properties proposed-value))
+
+	 (t
+	  ;; Else, just return whatever the constant was.
+	  proposed-value))
+  )
+
+(defun eieio-persistent-slot-type-is-class-p (type)
+  "Return the class refered to in TYPE.
+If no class is referenced there, then return nil."
+  (cond ((class-p type)
+	 ;; If the type is a class, then return it.
+	 type)
+
+	((and (symbolp type) (string-match "-child$" (symbol-name type))
+	      (class-p (intern-soft (substring (symbol-name type) 0
+					       (match-beginning 0)))))
+	 ;; If it is the predicate ending with -child, then return
+	 ;; that class.  Unfortunately, in EIEIO, typep of just the
+	 ;; class is the same as if we used -child, so no further work needed.
+	 (intern-soft (substring (symbol-name type) 0
+				 (match-beginning 0))))
+
+	((and (symbolp type) (string-match "-list$" (symbol-name type))
+	      (class-p (intern-soft (substring (symbol-name type) 0
+					       (match-beginning 0)))))
+	 ;; If it is the predicate ending with -list, then return
+	 ;; that class and the predicate to use.
+	 (cons (intern-soft (substring (symbol-name type) 0
+				       (match-beginning 0)))
+	       type))
+
+	((and (consp type) (eq (car type) 'or))
+	 ;; If type is a list, and is an or, it is possibly something
+	 ;; like (or null myclass), so check for that.
+	 (let ((ans nil))
+	   (dolist (subtype (cdr type))
+	     (setq ans (eieio-persistent-slot-type-is-class-p
+			subtype)))
+	   ans))
+
+	(t
+	 ;; No match, not a class.
+	 nil)))
+
 (defmethod object-write ((this eieio-persistent) &optional comment)
   "Write persistent object THIS out to the current stream.
 Optional argument COMMENT is a header line comment."
diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el
index e8d7bea50fa..cab9caad108 100644
--- a/lisp/emacs-lisp/eieio-custom.el
+++ b/lisp/emacs-lisp/eieio-custom.el
@@ -1,6 +1,6 @@
 ;;; eieio-custom.el -- eieio object customization
 
-;; Copyright (C) 1999-2001, 2005, 2007-2011  Free Software Foundation, Inc.
+;; Copyright (C) 1999-2001, 2005, 2007-2012  Free Software Foundation, Inc.
 
 ;; Author: Eric M. Ludlam <zappo@gnu.org>
 ;; Version: 0.2
@@ -332,6 +332,16 @@ Argument OBJ is the object that has been customized."
 Optional argument GROUP is the sub-group of slots to display."
   (eieio-customize-object obj group))
 
+(defvar eieio-custom-mode-map
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map widget-keymap)
+    map)
+  "Keymap for EIEIO Custom mode")
+
+(define-derived-mode eieio-custom-mode fundamental-mode "EIEIO Custom"
+  "Major mode for customizing EIEIO objects.
+\\{eieio-custom-mode-map}")
+
 (defmethod eieio-customize-object ((obj eieio-default-superclass)
 				   &optional group)
   "Customize OBJ in a specialized custom buffer.
@@ -345,8 +355,9 @@ These groups are specified with the `:group' slot flag."
 		       (concat "*CUSTOMIZE "
 			       (object-name obj) " "
 			       (symbol-name g) "*")))
-    (toggle-read-only -1)
+    (setq buffer-read-only nil)
     (kill-all-local-variables)
+    (eieio-custom-mode)
     (erase-buffer)
     (let ((all (overlay-lists)))
       ;; Delete all the overlays.
@@ -363,7 +374,6 @@ These groups are specified with the `:group' slot flag."
     (widget-insert "\n")
     (eieio-custom-object-apply-reset obj)
     ;; Now initialize the buffer
-    (use-local-map widget-keymap)
     (widget-setup)
     ;;(widget-minor-mode)
     (goto-char (point-min))
@@ -461,8 +471,4 @@ Return the symbol for the group, or nil"
 
 (provide 'eieio-custom)
 
-;; Local variables:
-;; generated-autoload-file: "eieio.el"
-;; End:
-
 ;;; eieio-custom.el ends here
diff --git a/lisp/emacs-lisp/eieio-datadebug.el b/lisp/emacs-lisp/eieio-datadebug.el
index 60510e1816c..a1db1972b83 100644
--- a/lisp/emacs-lisp/eieio-datadebug.el
+++ b/lisp/emacs-lisp/eieio-datadebug.el
@@ -1,6 +1,6 @@
 ;;; eieio-datadebug.el --- EIEIO extensions to the data debugger.
 
-;; Copyright (C) 2007-2011  Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012  Free Software Foundation, Inc.
 
 ;; Author: Eric M. Ludlam <zappo@gnu.org>
 ;; Keywords: OO, lisp
@@ -92,12 +92,11 @@ PREBUTTONTEXT is some text between PREFIX and the object button."
 				  "Class: ")
     ;; Loop over all the public slots
     (let ((publa (aref cv class-public-a))
-	  (publd (aref cv class-public-d))
 	  )
       (while publa
 	(if (slot-boundp obj (car publa))
-	    (let ((i (class-slot-initarg cl (car publa)))
-		  (v (eieio-oref obj (car publa))))
+	    (let* ((i (class-slot-initarg cl (car publa)))
+		   (v (eieio-oref obj (car publa))))
 	      (data-debug-insert-thing
 	       v prefix (concat
 			 (if i (symbol-name i)
@@ -112,7 +111,7 @@ PREBUTTONTEXT is some text between PREFIX and the object button."
 		     " ")
 	     'font-lock-keyword-face))
 	  )
-	(setq publa (cdr publa) publd (cdr publd))))))
+	(setq publa (cdr publa))))))
 
 ;;; Augment the Data debug thing display list.
 (data-debug-add-specialized-thing (lambda (thing) (object-p thing))
@@ -132,7 +131,7 @@ PREBUTTONTEXT is some text between PREFIX and the object button."
 (defun eieio-debug-methodinvoke (method class)
   "Show the method invocation order for METHOD with CLASS object."
   (interactive "aMethod: \nXClass Expression: ")
-  (let* ((eieio-pre-method-execution-hooks
+  (let* ((eieio-pre-method-execution-functions
 	  (lambda (l) (throw 'moose l) ))
 	 (data
 	  (catch 'moose (eieio-generic-call
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el
index 8869530dc23..c8bdd7758fa 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -1,10 +1,9 @@
 ;;; eieio-opt.el -- eieio optional functions (debug, printing, speedbar)
 
-;; Copyright (C) 1996, 1998-2003, 2005, 2008-2011
+;; Copyright (C) 1996, 1998-2003, 2005, 2008-2012
 ;;   Free Software Foundation, Inc.
 
 ;; Author: Eric M. Ludlam <zappo@gnu.org>
-;; Version: 0.2
 ;; Keywords: OO, lisp
 ;; Package: eieio
 
@@ -30,6 +29,9 @@
 ;;
 
 (require 'eieio)
+(require 'find-func)
+(require 'speedbar)
+(require 'help-mode)
 
 ;;; Code:
 ;;;###autoload
@@ -72,8 +74,7 @@ Argument CH-PREFIX is another character prefix to display."
 
 ;;; CLASS COMPLETION / DOCUMENTATION
 
-;;;###autoload
-(defalias 'describe-class 'eieio-describe-class)
+;;;###autoload(defalias 'describe-class 'eieio-describe-class)
 
 ;;;###autoload
 (defun eieio-describe-class (class &optional headerfcn)
@@ -86,11 +87,16 @@ Optional HEADERFCN should be called to insert a few bits of info first."
 		     (called-interactively-p 'interactive))
 
     (when headerfcn (funcall headerfcn))
-
-    (if (class-option class :abstract)
-	(princ "Abstract "))
-    (princ "Class ")
     (prin1 class)
+    (princ " is a")
+    (if (class-option class :abstract)
+	(princ "n abstract"))
+    (princ " class")
+    ;; Print file location
+    (when (get class 'class-location)
+      (princ " in `")
+      (princ (file-name-nondirectory (get class 'class-location)))
+      (princ "'"))
     (terpri)
     ;; Inheritance tree information
     (let ((pl (class-parents class)))
@@ -252,8 +258,13 @@ Uses `eieio-describe-class' to describe the class being constructed."
   (eieio-describe-class
    fcn (lambda ()
 	 ;; Describe the constructor part.
-	 (princ "Object Constructor Function: ")
 	 (prin1 fcn)
+	 (princ " is an object constructor function")
+	 ;; Print file location
+	 (when (get fcn 'class-location)
+	   (princ " in `")
+	   (princ (file-name-nondirectory (get fcn 'class-location)))
+	   (princ "'"))
 	 (terpri)
 	 (princ "Creates an object of class ")
 	 (prin1 fcn)
@@ -263,6 +274,16 @@ Uses `eieio-describe-class' to describe the class being constructed."
 	 ))
   )
 
+(defun eieio-build-class-list (class)
+  "Return a list of all classes that inherit from CLASS."
+  (if (class-p class)
+      (apply #'append
+	     (mapcar
+	      (lambda (c)
+		(append (list c) (eieio-build-class-list c)))
+	      (class-children-fast class)))
+    (list class)))
+
 (defun eieio-build-class-alist (&optional class instantiable-only buildlist)
   "Return an alist of all currently active classes for completion purposes.
 Optional argument CLASS is the class to start with.
@@ -271,8 +292,9 @@ are not abstract, otherwise allow all classes.
 Optional argument BUILDLIST is more list to attach and is used internally."
   (let* ((cc (or class eieio-default-superclass))
 	 (sublst (aref (class-v cc) class-children)))
-    (if (or (not instantiable-only) (not (class-abstract-p cc)))
-	(setq buildlist (cons (cons (symbol-name cc) 1) buildlist)))
+    (unless (assoc (symbol-name cc) buildlist)
+      (when (or (not instantiable-only) (not (class-abstract-p cc)))
+	(setq buildlist (cons (cons (symbol-name cc) 1) buildlist))))
     (while sublst
       (setq buildlist (eieio-build-class-alist
 		       (car sublst) instantiable-only buildlist))
@@ -305,8 +327,7 @@ are not abstract."
 ;;; METHOD COMPLETION / DOC
 
 (defalias 'describe-method 'eieio-describe-generic)
-;;;###autoload
-(defalias 'describe-generic 'eieio-describe-generic)
+;;;###autoload(defalias 'describe-generic 'eieio-describe-generic)
 (defalias 'eieio-describe-method 'eieio-describe-generic)
 
 ;;;###autoload
@@ -344,10 +365,10 @@ Also extracts information about all methods specific to this generic."
     (princ "Implementations:")
     (terpri)
     (terpri)
-    (let ((i 3)
+    (let ((i 4)
 	  (prefix [ ":STATIC" ":BEFORE" ":PRIMARY" ":AFTER" ] ))
       ;; Loop over fanciful generics
-      (while (< i 6)
+      (while (< i 7)
 	(let ((gm (aref (get generic 'eieio-method-tree) i)))
 	  (when gm
 	    (princ "Generic ")
@@ -359,8 +380,9 @@ Also extracts information about all methods specific to this generic."
 	(setq i (1+ i)))
       (setq i 0)
       ;; Loop over defined class-specific methods
-      (while (< i 3)
-	(let ((gm (reverse (aref (get generic 'eieio-method-tree) i))))
+      (while (< i 4)
+	(let ((gm (reverse (aref (get generic 'eieio-method-tree) i)))
+	      location)
 	  (while gm
 	    (princ "`")
 	    (prin1 (car (car gm)))
@@ -377,6 +399,13 @@ Also extracts information about all methods specific to this generic."
 	    ;; 3 because of cdr
 	    (princ (or (documentation (cdr (car gm)))
 		       "Undocumented"))
+	    ;; Print file location if available
+	    (when (and (setq location (get generic 'method-locations))
+		       (setq location (assoc (caar gm) location)))
+	      (setq location (cadr location))
+	      (princ "\n\nDefined in `")
+	      (princ (file-name-nondirectory location))
+	      (princ "'\n"))
 	    (setq gm (cdr gm))
 	    (terpri)
 	    (terpri)))
@@ -556,7 +585,65 @@ Optional argument HISTORYVAR is the variable to use as history."
 
 ;;; HELP AUGMENTATION
 ;;
-;;;###autoload
+(define-button-type 'eieio-method-def
+  :supertype 'help-xref
+  'help-function (lambda (class method file)
+		   (eieio-help-find-method-definition class method file))
+  'help-echo (purecopy "mouse-2, RET: find method's definition"))
+
+(define-button-type 'eieio-class-def
+  :supertype 'help-xref
+  'help-function (lambda (class file)
+		   (eieio-help-find-class-definition class file))
+  'help-echo (purecopy "mouse-2, RET: find class definition"))
+
+(defun eieio-help-find-method-definition (class method file)
+  (let ((filename (find-library-name file))
+	location buf)
+    (when (null filename)
+      (error "Cannot find library %s" file))
+    (setq buf (find-file-noselect filename))
+    (with-current-buffer buf
+      (goto-char (point-min))
+      (when
+	  (re-search-forward
+	   ;; Regexp for searching methods.
+	   (concat "(defmethod[ \t\r\n]+" method
+		   "\\([ \t\r\n]+:[a-zA-Z]+\\)?"
+		   "[ \t\r\n]+(\\s-*(\\(\\sw\\|\\s_\\)+\\s-+"
+		   class
+		   "\\s-*)")
+	   nil t)
+	(setq location (match-beginning 0))))
+    (if (null location)
+	(message "Unable to find location in file")
+      (pop-to-buffer buf)
+      (goto-char location)
+      (recenter)
+      (beginning-of-line))))
+
+(defun eieio-help-find-class-definition (class file)
+  (let ((filename (find-library-name file))
+	location buf)
+    (when (null filename)
+      (error "Cannot find library %s" file))
+    (setq buf (find-file-noselect filename))
+    (with-current-buffer buf
+      (goto-char (point-min))
+      (when
+	  (re-search-forward
+	   ;; Regexp for searching a class.
+	   (concat "(defclass[ \t\r\n]+" class "[ \t\r\n]+")
+	   nil t)
+	(setq location (match-beginning 0))))
+    (if (null location)
+	(message "Unable to find location in file")
+      (pop-to-buffer buf)
+      (goto-char location)
+      (recenter)
+      (beginning-of-line))))
+
+
 (defun eieio-help-mode-augmentation-maybee (&rest unused)
   "For buffers thrown into help mode, augment for EIEIO.
 Arguments UNUSED are not used."
@@ -599,14 +686,30 @@ Arguments UNUSED are not used."
 	(goto-char (point-min))
 	(while (re-search-forward "^\\(Private \\)?Slot:" nil t)
 	    (put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
+	(goto-char (point-min))
+	(cond
+	 ((looking-at "\\(.+\\) is a generic function")
+	  (let ((mname (match-string 1))
+		cname)
+	    (while (re-search-forward "^`\\(.+\\)'[^\0]+?Defined in `\\(.+\\)'" nil t)
+	      (setq cname (match-string-no-properties 1))
+	      (help-xref-button 2 'eieio-method-def cname
+				mname
+				(cadr (assoc (intern cname)
+					     (get (intern mname)
+						  'method-locations)))))))
+	 ((looking-at "\\(.+\\) is an object constructor function in `\\(.+\\)'")
+	  (let ((cname (match-string-no-properties 1)))
+	    (help-xref-button 2 'eieio-class-def cname
+			      (get (intern cname) 'class-location))))
+	 ((looking-at "\\(.+\\) is a\\(n abstract\\)? class in `\\(.+\\)'")
+	  (let ((cname (match-string-no-properties 1)))
+	    (help-xref-button 3 'eieio-class-def cname
+			      (get (intern cname) 'class-location)))))
 	))))
 
 ;;; SPEEDBAR SUPPORT
 ;;
-(eval-when-compile
-  (condition-case nil
-      (require 'speedbar)
-    (error (message "Error loading speedbar... ignored"))))
 
 (defvar eieio-class-speedbar-key-map nil
   "Keymap used when working with a project in speedbar.")
@@ -700,8 +803,4 @@ INDENT is the current indentation level."
 
 (provide 'eieio-opt)
 
-;; Local variables:
-;; generated-autoload-file: "eieio.el"
-;; End:
-
 ;;; eieio-opt.el ends here
diff --git a/lisp/emacs-lisp/eieio-speedbar.el b/lisp/emacs-lisp/eieio-speedbar.el
index 4ff3cc01978..327e5ced0e3 100644
--- a/lisp/emacs-lisp/eieio-speedbar.el
+++ b/lisp/emacs-lisp/eieio-speedbar.el
@@ -1,9 +1,8 @@
 ;;; eieio-speedbar.el -- Classes for managing speedbar displays.
 
-;; Copyright (C) 1999-2002, 2005, 2007-2011  Free Software Foundation, Inc.
+;; Copyright (C) 1999-2002, 2005, 2007-2012  Free Software Foundation, Inc.
 
 ;; Author: Eric M. Ludlam <zappo@gnu.org>
-;; Version: 0.2
 ;; Keywords: OO, tools
 ;; Package: eieio
 
@@ -191,23 +190,24 @@ that path."
 
 ;;; DEFAULT SUPERCLASS baseline methods
 ;;
-;; First, define methods onto the superclass so all classes
-;; will have some minor support.
+;; First, define methods with no class defined.  These will work as if
+;; on the default superclass.  Specifying no class will allow these to be used
+;; when no other methods are found, allowing multiple inheritance to work
+;; reliably with eieio-speedbar.
 
-(defmethod eieio-speedbar-description ((object eieio-default-superclass))
+(defmethod eieio-speedbar-description (object)
   "Return a string describing OBJECT."
   (object-name-string object))
 
-(defmethod eieio-speedbar-derive-line-path ((object eieio-default-superclass))
+(defmethod eieio-speedbar-derive-line-path (object)
   "Return the path which OBJECT has something to do with."
   nil)
 
-(defmethod eieio-speedbar-object-buttonname ((object eieio-default-superclass))
+(defmethod eieio-speedbar-object-buttonname (object)
   "Return a string to use as a speedbar button for OBJECT."
   (object-name-string object))
 
-(defmethod eieio-speedbar-make-tag-line ((object eieio-default-superclass)
-					 depth)
+(defmethod eieio-speedbar-make-tag-line (object depth)
   "Insert a tag line into speedbar at point for OBJECT.
 By default, all objects appear as simple TAGS with no need to inherit from
 the special `eieio-speedbar' classes.  Child classes should redefine this
@@ -220,7 +220,7 @@ Argument DEPTH is the depth at which the tag line is inserted."
 			  'speedbar-tag-face
 			  depth))
 
-(defmethod eieio-speedbar-handle-click ((object eieio-default-superclass))
+(defmethod eieio-speedbar-handle-click (object)
   "Handle a click action on OBJECT in speedbar.
 Any object can be represented as a tag in SPEEDBAR without special
 attributes.  These default objects will be pulled up in a custom
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 170d3fb0bf8..3f7b49bde25 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -1,7 +1,7 @@
 ;;; eieio.el --- Enhanced Implementation of Emacs Interpreted Objects
 ;;;              or maybe Eric's Implementation of Emacs Interpreted Objects
 
-;; Copyright (C) 1995-1996, 1998-2011  Free Software Foundation, Inc.
+;; Copyright (C) 1995-1996, 1998-2012  Free Software Foundation, Inc.
 
 ;; Author: Eric M. Ludlam <zappo@gnu.org>
 ;; Version: 1.3
@@ -44,8 +44,7 @@
 
 ;;; Code:
 
-(eval-when-compile
-  (require 'cl))
+(eval-when-compile (require 'cl))       ;FIXME: Use cl-lib!
 
 (defvar eieio-version "1.3"
   "Current version of EIEIO.")
@@ -79,7 +78,7 @@
 ;;
 
 (defvar eieio-hook nil
-  "*This hook is executed, then cleared each time `defclass' is called.")
+  "This hook is executed, then cleared each time `defclass' is called.")
 
 (defvar eieio-error-unsupported-class-tags nil
   "Non-nil to throw an error if an encountered tag is unsupported.
@@ -87,7 +86,7 @@ This may prevent classes from CLOS applications from being used with EIEIO
 since EIEIO does not support all CLOS tags.")
 
 (defvar eieio-skip-typecheck nil
-  "*If non-nil, skip all slot typechecking.
+  "If non-nil, skip all slot typechecking.
 Set this to t permanently if a program is functioning well to get a
 small speed increase.  This variable is also used internally to handle
 default setting for optimization purposes.")
@@ -95,21 +94,6 @@ default setting for optimization purposes.")
 (defvar eieio-optimize-primary-methods-flag t
   "Non-nil means to optimize the method dispatch on primary methods.")
 
-;; State Variables
-;; FIXME: These two constants below should have an `eieio-' prefix added!!
-(defvar this nil
-  "Inside a method, this variable is the object in question.
-DO NOT SET THIS YOURSELF unless you are trying to simulate friendly slots.
-
-Note: Embedded methods are no longer supported.  The variable THIS is
-still set for CLOS methods for the sake of routines like
-`call-next-method'.")
-
-(defvar scoped-class nil
-  "This is set to a class when a method is running.
-This is so we know we are allowed to check private parts or how to
-execute a `call-next-method'.  DO NOT SET THIS YOURSELF!")
-
 (defvar eieio-initializing-object  nil
   "Set to non-nil while initializing an object.")
 
@@ -411,6 +395,7 @@ It creates an autoload function for CNAME's constructor."
 	(autoload cname filename doc nil nil)
 	(autoload (intern (concat (symbol-name cname) "-p")) filename "" nil nil)
 	(autoload (intern (concat (symbol-name cname) "-child-p")) filename "" nil nil)
+	(autoload (intern (concat (symbol-name cname) "-list-p")) filename "" nil nil)
 
 	))))
 
@@ -431,10 +416,10 @@ See `defclass' for more information."
   (run-hooks 'eieio-hook)
   (setq eieio-hook nil)
 
-  (if (not (symbolp cname)) (signal 'wrong-type-argument '(symbolp cname)))
-  (if (not (listp superclasses)) (signal 'wrong-type-argument '(listp superclasses)))
+  (if (not (listp superclasses))
+      (signal 'wrong-type-argument '(listp superclasses)))
 
-  (let* ((pname (if superclasses superclasses nil))
+  (let* ((pname superclasses)
 	 (newc (make-vector class-num-slots nil))
 	 (oldc (when (class-p cname) (class-v cname)))
 	 (groups nil) ;; list of groups id'd from slots
@@ -540,6 +525,23 @@ See `defclass' for more information."
 	       (and (eieio-object-p obj)
 		    (object-of-class-p obj ,cname))))
 
+    ;; Create a handy list of the class test too
+    (let ((csym (intern (concat (symbol-name cname) "-list-p"))))
+      (fset csym
+	    `(lambda (obj)
+	       ,(format
+		  "Test OBJ to see if it a list of objects which are a child of type %s"
+		  cname)
+	       (when (listp obj)
+		 (let ((ans t)) ;; nil is valid
+		   ;; Loop over all the elements of the input list, test
+		   ;; each to make sure it is a child of the desired object class.
+		   (while (and obj ans)
+		     (setq ans (and (eieio-object-p (car obj))
+				    (object-of-class-p (car obj) ,cname)))
+		     (setq obj (cdr obj)))
+		   ans)))))
+
       ;; When using typep, (typep OBJ 'myclass) returns t for objects which
       ;; are subclasses of myclass.  For our predicates, however, it is
       ;; important for EIEIO to be backwards compatible, where
@@ -553,8 +555,8 @@ See `defclass' for more information."
       (put cname 'cl-deftype-handler
 	   (list 'lambda () `(list 'satisfies (quote ,csym)))))
 
-    ;; before adding new slots, let's add all the methods and classes
-    ;; in from the parent class
+    ;; Before adding new slots, let's add all the methods and classes
+    ;; in from the parent class.
     (eieio-copy-parents-into-subclass newc superclasses)
 
     ;; Store the new class vector definition into the symbol.  We need to
@@ -652,9 +654,9 @@ See `defclass' for more information."
 	;; We need to id the group, and store them in a group list attribute.
 	(mapc (lambda (cg) (add-to-list 'groups cg)) customg)
 
-	;; anyone can have an accessor function.  This creates a function
+	;; Anyone can have an accessor function.  This creates a function
 	;; of the specified name, and also performs a `defsetf' if applicable
-	;; so that users can `setf' the space returned by this function
+	;; so that users can `setf' the space returned by this function.
 	(if acces
 	    (progn
 	      (eieio--defmethod
@@ -668,18 +670,26 @@ See `defclass' for more information."
 			    ;; Else - Some error?  nil?
 			    nil)))
 
-	      ;; Provide a setf method.  It would be cleaner to use
-	      ;; defsetf, but that would require CL at runtime.
-	      (put acces 'setf-method
-		   `(lambda (widget)
-		      (let* ((--widget-sym-- (make-symbol "--widget--"))
-			     (--store-sym-- (make-symbol "--store--")))
-			(list
-			 (list --widget-sym--)
-			 (list widget)
-			 (list --store-sym--)
-			 (list 'eieio-oset --widget-sym-- '',name --store-sym--)
-			 (list 'getfoo --widget-sym--)))))))
+              (if (fboundp 'gv-define-setter)
+                  ;; FIXME: We should move more of eieio-defclass into the
+                  ;; defclass macro so we don't have to use `eval' and require
+                  ;; `gv' at run-time.
+                  (eval `(gv-define-setter ,acces (eieio--store eieio--object)
+                           (list 'eieio-oset eieio--object '',name
+                                 eieio--store)))
+                ;; Provide a setf method.  It would be cleaner to use
+                ;; defsetf, but that would require CL at runtime.
+                (put acces 'setf-method
+                     `(lambda (widget)
+                        (let* ((--widget-sym-- (make-symbol "--widget--"))
+                               (--store-sym-- (make-symbol "--store--")))
+                          (list
+                           (list --widget-sym--)
+                           (list widget)
+                           (list --store-sym--)
+                           (list 'eieio-oset --widget-sym-- '',name
+                                 --store-sym--)
+                           (list 'getfoo --widget-sym--))))))))
 
 	;; If a writer is defined, then create a generic method of that
 	;; name whose purpose is to set the value of the slot.
@@ -702,7 +712,8 @@ See `defclass' for more information."
 	)
       (setq slots (cdr slots)))
 
-    ;; Now that everything has been loaded up, all our lists are backwards!  Fix that up now.
+    ;; Now that everything has been loaded up, all our lists are backwards!
+    ;; Fix that up now.
     (aset newc class-public-a (nreverse (aref newc class-public-a)))
     (aset newc class-public-d (nreverse (aref newc class-public-d)))
     (aset newc class-public-doc (nreverse (aref newc class-public-doc)))
@@ -773,6 +784,16 @@ See `defclass' for more information."
     (put cname 'variable-documentation
 	 (class-option-assoc options :documentation))
 
+    ;; Save the file location where this class is defined.
+    (let ((fname (if load-in-progress
+		     load-file-name
+		   buffer-file-name))
+	  loc)
+      (when fname
+	(when (string-match "\\.elc$" fname)
+	  (setq fname (substring fname 0 (1- (length fname)))))
+	(put cname 'class-location fname)))
+
     ;; We have a list of custom groups.  Store them into the options.
     (let ((g (class-option-assoc options :custom-groups)))
       (mapc (lambda (cg) (add-to-list 'g cg)) groups)
@@ -1246,8 +1267,10 @@ IMPL is the symbol holding the method implementation."
 		  (eieio-generic-call-methodname ',method)
 		  (eieio-generic-call-arglst local-args)
 		  )
-	      (apply #',impl local-args)
-              ;;(,impl local-args)
+	      ,(if (< emacs-major-version 24)
+		  `(apply ,(list 'quote impl) local-args)
+		`(apply #',impl local-args))
+	      ;(,impl local-args)
 	      )))))))
 
 (defsubst eieio-defgeneric-reset-generic-form-primary-only-one (method)
@@ -1533,71 +1556,6 @@ Fills in OBJ's SLOT with its default value."
    ;; return it verbatim
    (t val)))
 
-;;; Object Set macros
-;;
-(defmacro oset (obj slot value)
-  "Set the value in OBJ for slot SLOT to VALUE.
-SLOT is the slot name as specified in `defclass' or the tag created
-with in the :initarg slot.  VALUE can be any Lisp object."
-  `(eieio-oset ,obj (quote ,slot) ,value))
-
-(defun eieio-oset (obj slot value)
-  "Do the work for the macro `oset'.
-Fills in OBJ's SLOT with VALUE."
-  (if (not (eieio-object-p obj)) (signal 'wrong-type-argument (list 'eieio-object-p obj)))
-  (if (not (symbolp slot)) (signal 'wrong-type-argument (list 'symbolp slot)))
-  (let ((c (eieio-slot-name-index (object-class-fast obj) obj slot)))
-    (if (not c)
-	;; It might be missing because it is a :class allocated slot.
-	;; Let's check that info out.
-	(if (setq c
-		  (eieio-class-slot-name-index (aref obj object-class) slot))
-	    ;; Oset that slot.
-	    (progn
-	      (eieio-validate-class-slot-value (object-class-fast obj) c value slot)
-	      (aset (aref (class-v (aref obj object-class))
-			  class-class-allocation-values)
-		    c value))
-	  ;; See oref for comment on `slot-missing'
-	  (slot-missing obj slot 'oset value)
-	  ;;(signal 'invalid-slot-name (list (object-name obj) slot))
-	  )
-      (eieio-validate-slot-value (object-class-fast obj) c value slot)
-      (aset obj c value))))
-
-(defmacro oset-default (class slot value)
-  "Set the default slot in CLASS for SLOT to VALUE.
-The default value is usually set with the :initform tag during class
-creation.  This allows users to change the default behavior of classes
-after they are created."
-  `(eieio-oset-default ,class (quote ,slot) ,value))
-
-(defun eieio-oset-default (class slot value)
-  "Do the work for the macro `oset-default'.
-Fills in the default value in CLASS' in SLOT with VALUE."
-  (if (not (class-p class)) (signal 'wrong-type-argument (list 'class-p class)))
-  (if (not (symbolp slot)) (signal 'wrong-type-argument (list 'symbolp slot)))
-  (let* ((scoped-class class)
-	 (c (eieio-slot-name-index class nil slot)))
-    (if (not c)
-	;; It might be missing because it is a :class allocated slot.
-	;; Let's check that info out.
-	(if (setq c (eieio-class-slot-name-index class slot))
-	    (progn
-	      ;; Oref that slot.
-	      (eieio-validate-class-slot-value class c value slot)
-	      (aset (aref (class-v class) class-class-allocation-values) c
-		    value))
-	  (signal 'invalid-slot-name (list (class-name class) slot)))
-      (eieio-validate-slot-value class c value slot)
-      ;; Set this into the storage for defaults.
-      (setcar (nthcdr (- c 3) (aref (class-v class) class-public-d))
-	      value)
-      ;; Take the value, and put it into our cache object.
-      (eieio-oset (aref (class-v class) class-default-object-cache)
-		  slot value)
-      )))
-
 ;;; Handy CLOS macros
 ;;
 (defmacro with-slots (spec-list object &rest body)
@@ -1848,6 +1806,71 @@ method invocation orders of the involved classes."
       (setq ia (cdr ia)))
     f))
 
+;;; Object Set macros
+;;
+(defmacro oset (obj slot value)
+  "Set the value in OBJ for slot SLOT to VALUE.
+SLOT is the slot name as specified in `defclass' or the tag created
+with in the :initarg slot.  VALUE can be any Lisp object."
+  `(eieio-oset ,obj (quote ,slot) ,value))
+
+(defun eieio-oset (obj slot value)
+  "Do the work for the macro `oset'.
+Fills in OBJ's SLOT with VALUE."
+  (if (not (eieio-object-p obj)) (signal 'wrong-type-argument (list 'eieio-object-p obj)))
+  (if (not (symbolp slot)) (signal 'wrong-type-argument (list 'symbolp slot)))
+  (let ((c (eieio-slot-name-index (object-class-fast obj) obj slot)))
+    (if (not c)
+	;; It might be missing because it is a :class allocated slot.
+	;; Let's check that info out.
+	(if (setq c
+		  (eieio-class-slot-name-index (aref obj object-class) slot))
+	    ;; Oset that slot.
+	    (progn
+	      (eieio-validate-class-slot-value (object-class-fast obj) c value slot)
+	      (aset (aref (class-v (aref obj object-class))
+			  class-class-allocation-values)
+		    c value))
+	  ;; See oref for comment on `slot-missing'
+	  (slot-missing obj slot 'oset value)
+	  ;;(signal 'invalid-slot-name (list (object-name obj) slot))
+	  )
+      (eieio-validate-slot-value (object-class-fast obj) c value slot)
+      (aset obj c value))))
+
+(defmacro oset-default (class slot value)
+  "Set the default slot in CLASS for SLOT to VALUE.
+The default value is usually set with the :initform tag during class
+creation.  This allows users to change the default behavior of classes
+after they are created."
+  `(eieio-oset-default ,class (quote ,slot) ,value))
+
+(defun eieio-oset-default (class slot value)
+  "Do the work for the macro `oset-default'.
+Fills in the default value in CLASS' in SLOT with VALUE."
+  (if (not (class-p class)) (signal 'wrong-type-argument (list 'class-p class)))
+  (if (not (symbolp slot)) (signal 'wrong-type-argument (list 'symbolp slot)))
+  (let* ((scoped-class class)
+	 (c (eieio-slot-name-index class nil slot)))
+    (if (not c)
+	;; It might be missing because it is a :class allocated slot.
+	;; Let's check that info out.
+	(if (setq c (eieio-class-slot-name-index class slot))
+	    (progn
+	      ;; Oref that slot.
+	      (eieio-validate-class-slot-value class c value slot)
+	      (aset (aref (class-v class) class-class-allocation-values) c
+		    value))
+	  (signal 'invalid-slot-name (list (class-name class) slot)))
+      (eieio-validate-slot-value class c value slot)
+      ;; Set this into the storage for defaults.
+      (setcar (nthcdr (- c 3) (aref (class-v class) class-public-d))
+	      value)
+      ;; Take the value, and put it into our cache object.
+      (eieio-oset (aref (class-v class) class-default-object-cache)
+		  slot value)
+      )))
+
 ;;; CLOS queries into classes and slots
 ;;
 (defun slot-boundp (object slot)
@@ -2000,13 +2023,13 @@ reverse-lookup that name, and recurse with the associated slot value."
 	 ((not (get fsym 'protection))
 	  (+ 3 fsi))
 	 ((and (eq (get fsym 'protection) 'protected)
-	       scoped-class
+	       (bound-and-true-p scoped-class)
 	       (or (child-of-class-p class scoped-class)
 		   (and (eieio-object-p obj)
 			(child-of-class-p class (object-class obj)))))
 	  (+ 3 fsi))
 	 ((and (eq (get fsym 'protection) 'private)
-	       (or (and scoped-class
+	       (or (and (bound-and-true-p scoped-class)
 			(eieio-slot-originating-class-p scoped-class slot))
 		   eieio-initializing-object))
 	  (+ 3 fsi))
@@ -2043,8 +2066,10 @@ Keys are a number representing :before, :primary, and :after methods.")
 During executions, the list is first generated, then as each next method
 is called, the next method is popped off the stack.")
 
-(defvar eieio-pre-method-execution-hooks nil
-  "*Hooks run just before a method is executed.
+(define-obsolete-variable-alias 'eieio-pre-method-execution-hooks
+  'eieio-pre-method-execution-functions "24.3")
+(defvar eieio-pre-method-execution-functions nil
+  "Abnormal hook run just before an EIEIO method is executed.
 The hook function must accept one argument, the list of forms
 about to be executed.")
 
@@ -2149,7 +2174,7 @@ This should only be called from a generic function."
 	      (eieiomt-method-list method method-primary nil)))
       )
 
-    (run-hook-with-args 'eieio-pre-method-execution-hooks
+    (run-hook-with-args 'eieio-pre-method-execution-functions
 			primarymethodlist)
 
     ;; Now loop through all occurrences forms which we must execute
@@ -2254,7 +2279,7 @@ for this common case to improve performance."
 
 	;; Do the regular implementation here.
 
-	(run-hook-with-args 'eieio-pre-method-execution-hooks
+	(run-hook-with-args 'eieio-pre-method-execution-functions
 			    lambdas)
 
 	(setq lastval (apply (car lambdas) newargs))
@@ -2311,7 +2336,7 @@ If REPLACEMENT-ARGS is non-nil, then use them instead of
 arguments passed in at the top level.
 
 Use `next-method-p' to find out if there is a next method to call."
-  (if (not scoped-class)
+  (if (not (bound-and-true-p scoped-class))
       (error "`call-next-method' not called within a class specific method"))
   (if (and (/= eieio-generic-call-key method-primary)
 	   (/= eieio-generic-call-key method-static))
@@ -2395,6 +2420,18 @@ CLASS is the class this method is associated with."
     (if (< key method-num-lists)
 	(let ((nsym (intern (symbol-name class) (aref emto key))))
 	  (fset nsym method)))
+    ;; Save the defmethod file location in a symbol property.
+    (let ((fname (if load-in-progress
+		     load-file-name
+		   buffer-file-name))
+	  loc)
+      (when fname
+	(when (string-match "\\.elc$" fname)
+	  (setq fname (substring fname 0 (1- (length fname)))))
+	(setq loc (get method-name 'method-locations))
+	(add-to-list 'loc
+		     (list class fname))
+	(put method-name 'method-locations loc)))
     ;; Now optimize the entire obarray
     (if (< key method-num-lists)
 	(let ((eieiomt-optimizing-obarray (aref emto key)))
@@ -2543,8 +2580,13 @@ This is usually a symbol that starts with `:'."
 ;;; Here are some CLOS items that need the CL package
 ;;
 
-(defsetf slot-value (obj slot) (store) (list 'eieio-oset obj slot store))
-(defsetf eieio-oref (obj slot) (store) (list 'eieio-oset obj slot store))
+(defsetf eieio-oref eieio-oset)
+
+(if (eval-when-compile (fboundp 'gv-define-expander))
+    ;; Not needed for Emacs>=24.3 since gv.el's setf expands macros and
+    ;; follows aliases.
+    nil
+(defsetf slot-value eieio-oset)
 
 ;; The below setf method was written by Arnd Kohrs <kohrs@acm.org>
 (define-setf-method oref (obj slot)
@@ -2558,7 +2600,7 @@ This is usually a symbol that starts with `:'."
 	    (list store-temp)
 	    (list 'set-slot-value obj-temp slot-temp
 		  store-temp)
-	    (list 'slot-value obj-temp slot-temp)))))
+	    (list 'slot-value obj-temp slot-temp))))))
 
 
 ;;;
@@ -2710,7 +2752,7 @@ This method signals `no-next-method' by default.  Override this
 method to not throw an error, and its return value becomes the
 return value of `call-next-method'."
   (signal 'no-next-method (list (object-name object) args))
-)
+  )
 
 (defgeneric clone (obj &rest params)
   "Make a copy of OBJ, and then supply PARAMS.
@@ -2794,9 +2836,9 @@ this object."
     (princ (make-string (* eieio-print-depth 2) ? ))
     (princ "(")
     (princ (symbol-name (class-constructor (object-class this))))
-    (princ " \"")
-    (princ (object-name-string this))
-    (princ "\"\n")
+    (princ " ")
+    (prin1 (object-name-string this))
+    (princ "\n")
     ;; Loop over all the public slots
     (let ((publa (aref cv class-public-a))
 	  (publd (aref cv class-public-d))
@@ -2863,7 +2905,6 @@ of `eq'."
 
 )
 
-
 ;;; Obsolete backward compatibility functions.
 ;; Needed to run byte-code compiled with the EIEIO of Emacs-23.
 
@@ -3008,29 +3049,6 @@ Optional argument NOESCAPE is passed to `prin1-to-string' when appropriate."
 	    )
 	  )
 
-;;; Interfacing with imenu in emacs lisp mode
-;;    (Only if the expression is defined)
-;;
-(if (eval-when-compile (boundp 'list-imenu-generic-expression))
-(progn
-
-(defun eieio-update-lisp-imenu-expression ()
-  "Examine `lisp-imenu-generic-expression' and modify it to find `defmethod'."
-  (let ((exp lisp-imenu-generic-expression))
-    (while exp
-      ;; it's of the form '( ( title expr indx ) ... )
-      (let* ((subcar (cdr (car exp)))
-	     (substr (car subcar)))
-	(if (and (not (string-match "|method\\\\" substr))
-		 (string-match "|advice\\\\" substr))
-	    (setcar subcar
-		    (replace-match "|advice\\|method\\" t t substr 0))))
-      (setq exp (cdr exp)))))
-
-(eieio-update-lisp-imenu-expression)
-
-))
-
 ;;; Autoloading some external symbols, and hooking into the help system
 ;;
 
@@ -3038,7 +3056,7 @@ Optional argument NOESCAPE is passed to `prin1-to-string' when appropriate."
 ;;; Start of automatically extracted autoloads.
 
 ;;;### (autoloads (customize-object) "eieio-custom" "eieio-custom.el"
-;;;;;;  "cf1bd64c76a6e6406545e8c5a5530d43")
+;;;;;;  "928623502e8bf40454822355388542b5")
 ;;; Generated autoloads from eieio-custom.el
 
 (autoload 'customize-object "eieio-custom" "\
@@ -3051,7 +3069,7 @@ Optional argument GROUP is the sub-group of slots to display.
 
 ;;;### (autoloads (eieio-help-mode-augmentation-maybee eieio-describe-generic
 ;;;;;;  eieio-describe-constructor eieio-describe-class eieio-browse)
-;;;;;;  "eieio-opt" "eieio-opt.el" "4fb6625c3a007438aab4e8e77b6c73c2")
+;;;;;;  "eieio-opt" "eieio-opt.el" "d808328f9c0156ecbd412d77ba8c569e")
 ;;; Generated autoloads from eieio-opt.el
 
 (autoload 'eieio-browse "eieio-opt" "\
@@ -3060,7 +3078,6 @@ If optional ROOT-CLASS, then start with that, otherwise start with
 variable `eieio-default-superclass'.
 
 \(fn &optional ROOT-CLASS)" t nil)
-
 (defalias 'describe-class 'eieio-describe-class)
 
 (autoload 'eieio-describe-class "eieio-opt" "\
@@ -3075,7 +3092,6 @@ Describe the constructor function FCN.
 Uses `eieio-describe-class' to describe the class being constructed.
 
 \(fn FCN)" t nil)
-
 (defalias 'describe-generic 'eieio-describe-generic)
 
 (autoload 'eieio-describe-generic "eieio-opt" "\
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 9822b556f34..6e5b8e92fb8 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -1,6 +1,6 @@
 ;;; eldoc.el --- show function arglist or variable docstring in echo area
 
-;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2012 Free Software Foundation, Inc.
 
 ;; Author: Noah Friedman <friedman@splode.com>
 ;; Maintainer: friedman@splode.com
diff --git a/lisp/emacs-lisp/elint.el b/lisp/emacs-lisp/elint.el
index ce6f8348a6b..2ff0ace9f4c 100644
--- a/lisp/emacs-lisp/elint.el
+++ b/lisp/emacs-lisp/elint.el
@@ -1,6 +1,6 @@
 ;;; elint.el --- Lint Emacs Lisp
 
-;; Copyright (C) 1997, 2001-2011  Free Software Foundation, Inc.
+;; Copyright (C) 1997, 2001-2012  Free Software Foundation, Inc.
 
 ;; Author: Peter Liljenberg <petli@lysator.liu.se>
 ;; Created: May 1997
@@ -46,6 +46,8 @@
 
 ;;; Code:
 
+(require 'help-fns)
+
 (defgroup elint nil
   "Linting for Emacs Lisp."
   :prefix "elint-"
@@ -357,6 +359,8 @@ Returns the forms."
     (set (make-local-variable 'elint-buffer-env)
 	 (elint-init-env elint-buffer-forms))
     (if elint-preloaded-env
+        ;; FIXME: This doesn't do anything!  Should we setq the result to
+        ;; elint-buffer-env?
 	(elint-env-add-env elint-preloaded-env elint-buffer-env))
     (set (make-local-variable 'elint-last-env-time) (buffer-modified-tick))
     elint-buffer-forms))
@@ -464,6 +468,9 @@ Return nil if there are no more forms, t otherwise."
 	(add-to-list 'elint-features name)
 	;; cl loads cl-macs in an opaque manner.
 	;; Since cl-macs requires cl, we can just process cl-macs.
+        ;; FIXME: AFAIK, `cl' now behaves properly and does not need any
+        ;; special treatment any more.  Can someone who understands this
+        ;; code confirm?  --Stef
 	(and (eq name 'cl) (not elint-doing-cl)
 	     ;; We need cl if elint-form is to be able to expand cl macros.
 	     (require 'cl)
@@ -708,14 +715,8 @@ Returns `unknown' if we couldn't find arguments."
 (defun elint-find-args-in-code (code)
   "Extract the arguments from CODE.
 CODE can be a lambda expression, a macro, or byte-compiled code."
-  (cond
-   ((byte-code-function-p code)
-    (aref code 0))
-   ((and (listp code) (eq (car code) 'lambda))
-    (car (cdr code)))
-   ((and (listp code) (eq (car code) 'macro))
-    (elint-find-args-in-code (cdr code)))
-   (t 'unknown)))
+  (let ((args (help-function-arglist code)))
+    (if (listp args) args 'unknown)))
 
 ;;;
 ;;; Functions to check some special forms
diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el
index b89b6decfc9..067b45f5cd8 100644
--- a/lisp/emacs-lisp/elp.el
+++ b/lisp/emacs-lisp/elp.el
@@ -1,6 +1,6 @@
-;;; elp.el --- Emacs Lisp Profiler
+;;; elp.el --- Emacs Lisp Profiler  -*- lexical-binding: t -*-
 
-;; Copyright (C) 1994-1995, 1997-1998, 2001-2011
+;; Copyright (C) 1994-1995, 1997-1998, 2001-2012
 ;;   Free Software Foundation, Inc.
 
 ;; Author: Barry A. Warsaw
@@ -124,6 +124,7 @@
 
 ;;; Code:
 
+(eval-when-compile (require 'cl-lib))
 
 ;; start of user configuration variables
 ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
@@ -148,9 +149,9 @@ Results are displayed with the `elp-results' command."
   "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
+  `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 your own sort function.  It should adhere to the
 interface specified by the PREDICATE argument for `sort'.
@@ -167,7 +168,7 @@ 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."
   :type '(choice integer
-		 (const :tag "Show All" nil))
+                 (const :tag "Show All" nil))
   :group 'elp)
 
 (defcustom elp-use-standard-output nil
@@ -193,9 +194,6 @@ In other words, a new unique buffer is create every time you run
 (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.")
@@ -205,7 +203,7 @@ This variable is set by the master function.")
 
 (defvar elp-not-profilable
   ;; First, the functions used inside each instrumented function:
-  '(elp-wrapper called-interactively-p
+  '(called-interactively-p
     ;; Then the functions used by the above functions.  I used
     ;; (delq nil (mapcar (lambda (x) (and (symbolp x) (fboundp x) x))
     ;;                   (aref (symbol-function 'elp-wrapper) 2)))
@@ -223,60 +221,21 @@ them would thus lead to infinite recursion.")
        (fboundp fun)
        (not (or (memq fun elp-not-profilable)
                 (keymapp fun)
-                (memq (car-safe (symbol-function fun)) '(autoload macro))
-                (condition-case nil
-                    (when (subrp (indirect-function fun))
-                      (eq 'unevalled
-                          (cdr (subr-arity (indirect-function fun)))))
-                  (error nil))))))
+                (autoloadp (symbol-function fun)) ;FIXME: Why not just load it?
+                (special-form-p fun)))))
 
+(defconst elp--advice-name 'ELP-instrumentation\ )
 
 ;;;###autoload
 (defun elp-instrument-function (funsym)
   "Instrument FUNSYM for profiling.
 FUNSYM must be a symbol of a defined function."
   (interactive "aFunction to instrument: ")
-  ;; restore the function.  this is necessary to avoid infinite
-  ;; recursion of already instrumented functions (i.e. elp-wrapper
-  ;; calling elp-wrapper ad infinitum).  it is better to simply
-  ;; restore the function than to throw an error.  this will work
-  ;; properly in the face of eval-defun because if the function was
-  ;; redefined, only the timer info will be nil'd out since
-  ;; elp-restore-function is smart enough not to trash the new
-  ;; definition.
-  (elp-restore-function funsym)
-  (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))
-    ;; TBD: at some point it might be better to load the autoloaded
-    ;; function instead of throwing an error.  if we do this, then we
-    ;; probably want elp-instrument-package to be updated with the
-    ;; newly loaded list of functions.  i'm not sure it's smart to do
-    ;; the autoload here, since that could have side effects, and
-    ;; elp-instrument-function is similar (in my mind) to defun-ish
-    ;; type functionality (i.e. it shouldn't execute the function).
-    (and (eq (car-safe funguts) 'autoload)
-	 (error "ELP cannot profile autoloaded function: %s" funsym))
+  (let* ((infovec (vector 0 0)))
     ;; We cannot profile functions used internally during profiling.
     (unless (elp-profilable-p funsym)
       (error "ELP cannot profile the function: %s" funsym))
-    ;; put rest of newguts together
-    (if (commandp funsym)
-	(setq newguts (append newguts '((interactive)))))
-    (setq newguts (append newguts `((elp-wrapper
-				     (quote ,funsym)
-				     ,(when (commandp funsym)
-					'(called-interactively-p 'any))
-				     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
+    ;; The info vector data structure is a 2 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:
@@ -285,72 +244,45 @@ FUNSYM must be a symbol of a defined function."
     ;; The 1st element is the total amount of time in seconds that has
     ;; 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 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.
-    (let ((advice-info (get funsym 'ad-advice-info)))
-      (if advice-info
-	  (progn
-	    ;; If function is advised, don't let Advice change
-	    ;; its definition from under us during the `fset'.
-	    (put funsym 'ad-advice-info nil)
-	    (fset funsym newguts)
-	    (put funsym 'ad-advice-info advice-info))
-	(fset funsym newguts)))
-
-    ;; add this function to the instrumentation list
-    (unless (memq funsym elp-all-instrumented-list)
-      (push funsym elp-all-instrumented-list))))
+    ;; ELP wrapper.
+    (advice-add funsym :around (elp--make-wrapper funsym)
+                `((name . ,elp--advice-name)))))
+
+(defun elp--instrumented-p (sym)
+  (advice-member-p elp--advice-name sym))
 
 (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, or loaded a
-    ;; byte-compiled version, while the function was instrumented and
-    ;; we don't want to destroy the new definition.  can it ever be
-    ;; the case that a lisp function can be compiled instrumented?
-    (and info
-	 (functionp funsym)
-	 (not (byte-code-function-p (symbol-function funsym)))
-	 (assq 'elp-wrapper (symbol-function funsym))
-	 (fset funsym (aref info 2)))))
+  (interactive
+   (list
+    (intern
+     (completing-read "Function to restore: " obarray
+                      #'elp--instrumented-p t))))
+  ;; 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)
+
+  (advice-remove funsym elp--advice-name))
 
 ;;;###autoload
 (defun elp-instrument-list (&optional list)
   "Instrument, for profiling, all functions in `elp-function-list'.
 Use optional LIST if provided instead.
 If called interactively, read LIST using the minibuffer."
-  (interactive "PList of functions to instrument: ")
+  (interactive "PList of functions to instrument: ") ;FIXME: Doesn't work?!
   (unless (listp list)
     (signal 'wrong-type-argument (list 'listp list)))
-  (let ((list (or list elp-function-list)))
-    (mapcar 'elp-instrument-function list)))
+  (mapcar #'elp-instrument-function (or list elp-function-list)))
 
 ;;;###autoload
 (defun elp-instrument-package (prefix)
@@ -371,15 +303,13 @@ For example, to instrument all ELP functions, do the following:
 (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)))
+  (interactive "PList of functions to restore: ") ;FIXME: Doesn't work!?
+  (mapcar #'elp-restore-function (or list elp-function-list)))
 
 (defun elp-restore-all ()
   "Restore the original definitions of all functions being profiled."
   (interactive)
-  (elp-restore-list elp-all-instrumented-list))
-
+  (mapatoms #'elp-restore-function))
 
 (defun elp-reset-function (funsym)
   "Reset the profiling information for FUNSYM."
@@ -395,30 +325,36 @@ Use optional LIST if provided instead."
 (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: ")
+  (interactive "PList of functions to reset: ") ;FIXME: Doesn't work!?
   (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))
+  (mapatoms (lambda (sym)
+              (if (get sym elp-timer-info-property)
+                  (elp-reset-function sym)))))
 
 (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
+  (interactive
+   (list
+    (intern
+     (completing-read "Master function: " obarray
+                      #'elp--instrumented-p
+                      t nil nil (if elp-master (symbol-name elp-master))))))
+  ;; 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)
+  ;; Make sure master function is instrumented.
+  (or (elp--instrumented-p funsym)
       (elp-instrument-function funsym)))
 
 (defun elp-unset-master ()
   "Unset the master function."
   (interactive)
-  ;; when there's no master function, recording is turned on by default.
+  ;; When there's no master function, recording is turned on by default.
   (setq elp-master nil
 	elp-record-p t))
 
@@ -426,49 +362,40 @@ Use optional LIST if provided instead."
 (defsubst elp-elapsed-time (start end)
   (float-time (time-subtract end start)))
 
-(defun elp-wrapper (funsym interactive-p args)
-  "This function has been instrumented for profiling by the ELP.
+(defun elp--make-wrapper (funsym)
+  "Make the piece of advice that instruments FUNSYM."
+  (lambda (func &rest 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 exit-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
-	(if interactive-p
-	    (setq enter-time (current-time)
-		  result (call-interactively func)
-		  exit-time (current-time))
+    ;; 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))
+           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 (apply func args))
+        ;; we are recording times
+        (let (enter-time exit-time)
+          ;; increment the call-counter
+          (cl-incf (aref info 0))
 	  (setq enter-time (current-time)
 		result (apply func args)
-		exit-time (current-time)))
-	;; calculate total time in function
-	(aset info 1 (+ (aref info 1) (elp-elapsed-time enter-time exit-time)))
-	))
-    ;; turn off recording if this is the master function
-    (if (and elp-master
-	     (eq funsym elp-master))
-	(setq elp-record-p nil))
-    result))
+                exit-time (current-time))
+          ;; calculate total time in function
+          (cl-incf (aref info 1) (elp-elapsed-time enter-time exit-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
@@ -582,57 +509,58 @@ displayed."
 	   (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))
+	   (resvec '())
 	   )				; end let*
+      (mapatoms
+       (lambda (funsym)
+         (when (elp--instrumented-p 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)))
+               (push
+                (vector cc tt (if (zerop cc)
+                                  0.0 ;avoid arithmetic div-by-zero errors
+                                (/ (float tt) (float cc)))
+                        symname)
+                resvec))))))
       ;; If printing to stdout, insert the header so it will print.
       ;; Otherwise use header-line-format.
       (setq elp-field-len (max titlelen longest))
       (if (or elp-use-standard-output noninteractive)
-         (progn
-           (insert title)
-           (if (> longest titlelen)
-               (progn
-                 (insert-char 32 (- longest titlelen))))
-           (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"))
-       (let ((column 0))
-         (setq header-line-format
-               (mapconcat
-                (lambda (title)
-                  (prog1
-                      (concat
-                       (propertize " "
-                                   'display (list 'space :align-to column)
-                                   'face 'fixed-pitch)
-                       title)
-                    (setq column (+ column 2
-                                    (if (= column 0)
-                                        elp-field-len
-                                      (length title))))))
-                (list title cc-header et-header at-header) ""))))
+          (progn
+            (insert title)
+            (if (> longest titlelen)
+                (progn
+                  (insert-char 32 (- longest titlelen))))
+            (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"))
+        (let ((column 0))
+          (setq header-line-format
+                (mapconcat
+                 (lambda (title)
+                   (prog1
+                       (concat
+                        (propertize " "
+                                    'display (list 'space :align-to column)
+                                    'face 'fixed-pitch)
+                        title)
+                     (setq column (+ column 2
+                                     (if (= column 0)
+                                         elp-field-len
+                                       (length title))))))
+                 (list title cc-header et-header at-header) ""))))
       ;; if sorting is enabled, then sort the results list. in either
       ;; case, call elp-output-result to output the result in the
       ;; buffer
@@ -644,7 +572,7 @@ displayed."
     (pop-to-buffer resultsbuf)
     ;; copy results to standard-output?
     (if (or elp-use-standard-output noninteractive)
-       (princ (buffer-substring (point-min) (point-max)))
+        (princ (buffer-substring (point-min) (point-max)))
       (goto-char (point-min)))
     ;; reset profiling info if desired
     (and elp-reset-after-results
diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el
index 39d4a4e814a..60d74774e87 100644
--- a/lisp/emacs-lisp/ert-x.el
+++ b/lisp/emacs-lisp/ert-x.el
@@ -1,24 +1,24 @@
-;;; ert-x.el --- Staging area for experimental extensions to ERT
+;;; ert-x.el --- Staging area for experimental extensions to ERT  -*- lexical-binding: t -*-
 
-;; Copyright (C) 2008, 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2008, 2010-2012 Free Software Foundation, Inc.
 
 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
-;; Author: Christian Ohler <ohler@gnu.org>
+;;         Christian Ohler <ohler@gnu.org>
 
 ;; This file is part of GNU Emacs.
 
-;; 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 3 of the
-;; License, 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.
-;;
+;; 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 3 of the License, 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 this program.  If not, see `http://www.gnu.org/licenses/'.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -28,8 +28,7 @@
 
 ;;; Code:
 
-(eval-when-compile
-  (require 'cl))
+(eval-when-compile (require 'cl-lib))
 (require 'ert)
 
 
@@ -90,8 +89,8 @@ ERT--THUNK with that buffer as current."
       (kill-buffer ert--buffer)
       (remhash ert--buffer ert--test-buffers))))
 
-(defmacro* ert-with-test-buffer ((&key ((:name name-form)))
-				 &body body)
+(cl-defmacro ert-with-test-buffer ((&key ((:name name-form)))
+                                   &body body)
   "Create a test buffer and run BODY in that buffer.
 
 To be used in ERT tests.  If BODY finishes successfully, the test
@@ -116,10 +115,10 @@ the name of the test and the result of NAME-FORM."
   "Kill all test buffers that are still live."
   (interactive)
   (let ((count 0))
-    (maphash (lambda (buffer dummy)
+    (maphash (lambda (buffer _dummy)
 	       (when (or (not (buffer-live-p buffer))
 			 (kill-buffer buffer))
-		 (incf count)))
+		 (cl-incf count)))
 	     ert--test-buffers)
     (message "%s out of %s test buffers killed"
 	     count (hash-table-count ert--test-buffers)))
@@ -149,9 +148,9 @@ the rest are arguments to the command.
 
 NOTE: Since the command is not called by `call-interactively'
 test for `called-interactively' in the command will fail."
-  (assert (listp command) t)
-  (assert (commandp (car command)) t)
-  (assert (not unread-command-events) t)
+  (cl-assert (listp command) t)
+  (cl-assert (commandp (car command)) t)
+  (cl-assert (not unread-command-events) t)
   (let (return-value)
     ;; For the order of things here see command_loop_1 in keyboard.c.
     ;;
@@ -167,14 +166,15 @@ test for `called-interactively' in the command will fail."
     (run-hooks 'pre-command-hook)
     (setq return-value (apply (car command) (cdr command)))
     (run-hooks 'post-command-hook)
-    (when deferred-action-list
-      (run-hooks 'deferred-action-function))
+    (and (boundp 'deferred-action-list)
+         deferred-action-list
+         (run-hooks 'deferred-action-function))
     (setq real-last-command (car command)
           last-command this-command)
     (when (boundp 'last-repeatable-command)
       (setq last-repeatable-command real-last-command))
     (when (and deactivate-mark transient-mark-mode) (deactivate-mark))
-    (assert (not unread-command-events) t)
+    (cl-assert (not unread-command-events) t)
     return-value))
 
 (defun ert-run-idle-timers ()
@@ -197,7 +197,7 @@ rather than the entire match."
   (with-temp-buffer
     (insert s)
     (dolist (x regexps)
-      (destructuring-bind (regexp subexp) (if (listp x) x `(,x nil))
+      (cl-destructuring-bind (regexp subexp) (if (listp x) x `(,x nil))
         (goto-char (point-min))
         (while (re-search-forward regexp nil t)
           (replace-match "" t t nil subexp))))
@@ -223,15 +223,15 @@ would return the string \"foo bar baz quux\" where the substring
 None of the ARGS are modified, but the return value may share
 structure with the plists in ARGS."
   (with-temp-buffer
-    (loop with current-plist = nil
-          for x in args do
-          (etypecase x
-            (string (let ((begin (point)))
-                      (insert x)
-                      (set-text-properties begin (point) current-plist)))
-            (list (unless (zerop (mod (length x) 2))
-                    (error "Odd number of args in plist: %S" x))
-                  (setq current-plist x))))
+    (cl-loop with current-plist = nil
+             for x in args do
+             (cl-etypecase x
+               (string (let ((begin (point)))
+                         (insert x)
+                         (set-text-properties begin (point) current-plist)))
+               (list (unless (zerop (mod (length x) 2))
+                       (error "Odd number of args in plist: %S" x))
+                     (setq current-plist x))))
     (buffer-string)))
 
 
@@ -244,8 +244,8 @@ buffer, and renames the original buffer back to BUFFER-NAME.
 
 This is useful if THUNK has undesirable side-effects on an Emacs
 buffer with a fixed name such as *Messages*."
-  (lexical-let ((new-buffer-name (generate-new-buffer-name
-                                  (format "%s orig buffer" buffer-name))))
+  (let ((new-buffer-name (generate-new-buffer-name
+                          (format "%s orig buffer" buffer-name))))
     (with-current-buffer (get-buffer-create buffer-name)
       (rename-buffer new-buffer-name))
     (unwind-protect
@@ -257,7 +257,7 @@ buffer with a fixed name such as *Messages*."
       (with-current-buffer new-buffer-name
         (rename-buffer buffer-name)))))
 
-(defmacro* ert-with-buffer-renamed ((buffer-name-form) &body body)
+(cl-defmacro ert-with-buffer-renamed ((buffer-name-form) &body body)
   "Protect the buffer named BUFFER-NAME from side-effects and run BODY.
 
 See `ert-call-with-buffer-renamed' for details."
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 820519e92d8..ab6dcb58143 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -1,24 +1,24 @@
-;;; ert.el --- Emacs Lisp Regression Testing
+;;; ert.el --- Emacs Lisp Regression Testing  -*- lexical-binding: t -*-
 
-;; Copyright (C) 2007-2008, 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2008, 2010-2012 Free Software Foundation, Inc.
 
 ;; Author: Christian Ohler <ohler@gnu.org>
 ;; Keywords: lisp, tools
 
 ;; This file is part of GNU Emacs.
 
-;; 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 3 of the
-;; License, 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.
-;;
+;; 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 3 of the License, 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 this program.  If not, see `http://www.gnu.org/licenses/'.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -54,8 +54,7 @@
 
 ;;; Code:
 
-(eval-when-compile
-  (require 'cl))
+(eval-when-compile (require 'cl-lib))
 (require 'button)
 (require 'debug)
 (require 'easymenu)
@@ -105,33 +104,33 @@
   "A reimplementation of `remove-if-not'.
 
 ERT-PRED is a predicate, ERT-LIST is the input list."
-  (loop for ert-x in ert-list
-        if (funcall ert-pred ert-x)
-        collect ert-x))
+  (cl-loop for ert-x in ert-list
+           if (funcall ert-pred ert-x)
+           collect ert-x))
 
 (defun ert--intersection (a b)
   "A reimplementation of `intersection'.  Intersect the sets A and B.
 
 Elements are compared using `eql'."
-  (loop for x in a
-        if (memql x b)
-        collect x))
+  (cl-loop for x in a
+           if (memql x b)
+           collect x))
 
 (defun ert--set-difference (a b)
   "A reimplementation of `set-difference'.  Subtract the set B from the set A.
 
 Elements are compared using `eql'."
-  (loop for x in a
-        unless (memql x b)
-        collect x))
+  (cl-loop for x in a
+           unless (memql x b)
+           collect x))
 
 (defun ert--set-difference-eq (a b)
   "A reimplementation of `set-difference'.  Subtract the set B from the set A.
 
 Elements are compared using `eq'."
-  (loop for x in a
-        unless (memq x b)
-        collect x))
+  (cl-loop for x in a
+           unless (memq x b)
+           collect x))
 
 (defun ert--union (a b)
   "A reimplementation of `union'.  Compute the union of the sets A and B.
@@ -149,7 +148,7 @@ Elements are compared using `eql'."
     (make-symbol (format "%s%s"
                          prefix
                          (prog1 ert--gensym-counter
-                           (incf ert--gensym-counter))))))
+                           (cl-incf ert--gensym-counter))))))
 
 (defun ert--coerce-to-vector (x)
   "Coerce X to a vector."
@@ -158,19 +157,19 @@ Elements are compared using `eql'."
       x
     (vconcat x)))
 
-(defun* ert--remove* (x list &key key test)
+(cl-defun ert--remove* (x list &key key test)
   "Does not support all the keywords of remove*."
   (unless key (setq key #'identity))
   (unless test (setq test #'eql))
-  (loop for y in list
-        unless (funcall test x (funcall key y))
-        collect y))
+  (cl-loop for y in list
+           unless (funcall test x (funcall key y))
+           collect y))
 
 (defun ert--string-position (c s)
   "Return the position of the first occurrence of C in S, or nil if none."
-  (loop for i from 0
-        for x across s
-        when (eql x c) return i))
+  (cl-loop for i from 0
+           for x across s
+           when (eql x c) return i))
 
 (defun ert--mismatch (a b)
   "Return index of first element that differs between A and B.
@@ -184,29 +183,30 @@ Like `mismatch'.  Uses `equal' for comparison."
         (t
          (let ((la (length a))
                (lb (length b)))
-           (assert (arrayp a) t)
-           (assert (arrayp b) t)
-           (assert (<= la lb) t)
-           (loop for i below la
-                 when (not (equal (aref a i) (aref b i))) return i
-                 finally (return (if (/= la lb)
-                                     la
-                                   (assert (equal a b) t)
-                                   nil)))))))
+           (cl-assert (arrayp a) t)
+           (cl-assert (arrayp b) t)
+           (cl-assert (<= la lb) t)
+           (cl-loop for i below la
+                    when (not (equal (aref a i) (aref b i))) return i
+                    finally (cl-return (if (/= la lb)
+                                           la
+                                         (cl-assert (equal a b) t)
+                                         nil)))))))
 
 (defun ert--subseq (seq start &optional end)
   "Return a subsequence of SEQ from START to END."
   (when (char-table-p seq) (error "Not supported"))
   (let ((vector (substring (ert--coerce-to-vector seq) start end)))
-    (etypecase seq
+    (cl-etypecase seq
       (vector vector)
       (string (concat vector))
       (list (append vector nil))
-      (bool-vector (loop with result = (make-bool-vector (length vector) nil)
-                         for i below (length vector) do
-                         (setf (aref result i) (aref vector i))
-                         finally (return result)))
-      (char-table (assert nil)))))
+      (bool-vector (cl-loop with result
+                            = (make-bool-vector (length vector) nil)
+                            for i below (length vector) do
+                            (setf (aref result i) (aref vector i))
+                            finally (cl-return result)))
+      (char-table (cl-assert nil)))))
 
 (defun ert-equal-including-properties (a b)
   "Return t if A and B have similar structure and contents.
@@ -225,10 +225,10 @@ Emacs bug 6581 at URL `http://debbugs.gnu.org/cgi/bugreport.cgi?bug=6581'."
 ;;; Defining and locating tests.
 
 ;; The data structure that represents a test case.
-(defstruct ert-test
+(cl-defstruct ert-test
   (name nil)
   (documentation nil)
-  (body (assert nil))
+  (body (cl-assert nil))
   (most-recent-result nil)
   (expected-result-type ':passed)
   (tags '()))
@@ -273,7 +273,7 @@ Returns a two-element list containing the keys-and-values plist
 and the body."
   (let ((extracted-key-accu '())
         (remaining keys-and-body))
-    (while (and (consp remaining) (keywordp (first remaining)))
+    (while (keywordp (car-safe remaining))
       (let ((keyword (pop remaining)))
         (unless (consp remaining)
           (error "Value expected after keyword %S in %S"
@@ -283,13 +283,13 @@ and the body."
                 keys-and-body))
         (push (cons keyword (pop remaining)) extracted-key-accu)))
     (setq extracted-key-accu (nreverse extracted-key-accu))
-    (list (loop for (key . value) in extracted-key-accu
-                collect key
-                collect value)
+    (list (cl-loop for (key . value) in extracted-key-accu
+                   collect key
+                   collect value)
           remaining)))
 
 ;;;###autoload
-(defmacro* ert-deftest (name () &body docstring-keys-and-body)
+(cl-defmacro ert-deftest (name () &body docstring-keys-and-body)
   "Define NAME (a symbol) as a test.
 
 BODY is evaluated as a `progn' when the test is run.  It should
@@ -313,12 +313,13 @@ description of valid values for RESULT-TYPE.
            (indent 2))
   (let ((documentation nil)
         (documentation-supplied-p nil))
-    (when (stringp (first docstring-keys-and-body))
+    (when (stringp (car docstring-keys-and-body))
       (setq documentation (pop docstring-keys-and-body)
             documentation-supplied-p t))
-    (destructuring-bind ((&key (expected-result nil expected-result-supplied-p)
-                               (tags nil tags-supplied-p))
-                         body)
+    (cl-destructuring-bind
+        ((&key (expected-result nil expected-result-supplied-p)
+               (tags nil tags-supplied-p))
+         body)
         (ert--parse-keys-and-body docstring-keys-and-body)
       `(progn
          (ert-set-test ',name
@@ -388,16 +389,11 @@ DATA is displayed to the user and should state the reason of the failure."
 (defun ert--expand-should-1 (whole form inner-expander)
   "Helper function for the `should' macro and its variants."
   (let ((form
-         ;; If `cl-macroexpand' isn't bound, the code that we're
-         ;; compiling doesn't depend on cl and thus doesn't need an
-         ;; environment arg for `macroexpand'.
-         (if (fboundp 'cl-macroexpand)
-             ;; Suppress warning about run-time call to cl function: we
-             ;; only call it if it's fboundp.
-             (with-no-warnings
-               (cl-macroexpand form (and (boundp 'cl-macro-environment)
-                                         cl-macro-environment)))
-           (macroexpand form))))
+         (macroexpand form (cond
+                            ((boundp 'macroexpand-all-environment)
+                             macroexpand-all-environment)
+                            ((boundp 'cl-macro-environment)
+                             cl-macro-environment)))))
     (cond
      ((or (atom form) (ert--special-operator-p (car form)))
       (let ((value (ert--gensym "value-")))
@@ -410,10 +406,10 @@ DATA is displayed to the user and should state the reason of the failure."
      (t
       (let ((fn-name (car form))
             (arg-forms (cdr form)))
-        (assert (or (symbolp fn-name)
-                    (and (consp fn-name)
-                         (eql (car fn-name) 'lambda)
-                         (listp (cdr fn-name)))))
+        (cl-assert (or (symbolp fn-name)
+                       (and (consp fn-name)
+                            (eql (car fn-name) 'lambda)
+                            (listp (cdr fn-name)))))
         (let ((fn (ert--gensym "fn-"))
               (args (ert--gensym "args-"))
               (value (ert--gensym "value-"))
@@ -451,35 +447,34 @@ should return code that calls INNER-FORM and performs the checks
 and error signaling specific to the particular variant of
 `should'.  The code that INNER-EXPANDER returns must not call
 FORM-DESCRIPTION-FORM before it has called INNER-FORM."
-  (lexical-let ((inner-expander inner-expander))
-    (ert--expand-should-1
-     whole form
-     (lambda (inner-form form-description-form value-var)
-       (let ((form-description (ert--gensym "form-description-")))
-         `(let (,form-description)
-            ,(funcall inner-expander
-                      `(unwind-protect
-                           ,inner-form
-                         (setq ,form-description ,form-description-form)
-                         (ert--signal-should-execution ,form-description))
-                      `,form-description
-                      value-var)))))))
-
-(defmacro* should (form)
+  (ert--expand-should-1
+   whole form
+   (lambda (inner-form form-description-form value-var)
+     (let ((form-description (ert--gensym "form-description-")))
+       `(let (,form-description)
+          ,(funcall inner-expander
+                    `(unwind-protect
+                         ,inner-form
+                       (setq ,form-description ,form-description-form)
+                       (ert--signal-should-execution ,form-description))
+                    `,form-description
+                    value-var))))))
+
+(cl-defmacro should (form)
   "Evaluate FORM.  If it returns nil, abort the current test as failed.
 
 Returns the value of FORM."
   (ert--expand-should `(should ,form) form
-                      (lambda (inner-form form-description-form value-var)
+                      (lambda (inner-form form-description-form _value-var)
                         `(unless ,inner-form
                            (ert-fail ,form-description-form)))))
 
-(defmacro* should-not (form)
+(cl-defmacro should-not (form)
   "Evaluate FORM.  If it returns non-nil, abort the current test as failed.
 
 Returns nil."
   (ert--expand-should `(should-not ,form) form
-                      (lambda (inner-form form-description-form value-var)
+                      (lambda (inner-form form-description-form _value-var)
                         `(unless (not ,inner-form)
                            (ert-fail ,form-description-form)))))
 
@@ -490,10 +485,10 @@ Returns nil."
 Determines whether CONDITION matches TYPE and EXCLUDE-SUBTYPES,
 and aborts the current test as failed if it doesn't."
   (let ((signaled-conditions (get (car condition) 'error-conditions))
-        (handled-conditions (etypecase type
+        (handled-conditions (cl-etypecase type
                               (list type)
                               (symbol (list type)))))
-    (assert signaled-conditions)
+    (cl-assert signaled-conditions)
     (unless (ert--intersection signaled-conditions handled-conditions)
       (ert-fail (append
                  (funcall form-description-fn)
@@ -512,7 +507,7 @@ and aborts the current test as failed if it doesn't."
 
 ;; FIXME: The expansion will evaluate the keyword args (if any) in
 ;; nonstandard order.
-(defmacro* should-error (form &rest keys &key type exclude-subtypes)
+(cl-defmacro should-error (form &rest keys &key type exclude-subtypes)
   "Evaluate FORM and check that it signals an error.
 
 The error signaled needs to match TYPE.  TYPE should be a list
@@ -560,19 +555,19 @@ failed."
 
 (defun ert--proper-list-p (x)
   "Return non-nil if X is a proper list, nil otherwise."
-  (loop
+  (cl-loop
    for firstp = t then nil
    for fast = x then (cddr fast)
    for slow = x then (cdr slow) do
-   (when (null fast) (return t))
-   (when (not (consp fast)) (return nil))
-   (when (null (cdr fast)) (return t))
-   (when (not (consp (cdr fast))) (return nil))
-   (when (and (not firstp) (eq fast slow)) (return nil))))
+   (when (null fast) (cl-return t))
+   (when (not (consp fast)) (cl-return nil))
+   (when (null (cdr fast)) (cl-return t))
+   (when (not (consp (cdr fast))) (cl-return nil))
+   (when (and (not firstp) (eq fast slow)) (cl-return nil))))
 
 (defun ert--explain-format-atom (x)
   "Format the atom X for `ert--explain-equal'."
-  (typecase x
+  (cl-typecase x
     (fixnum (list x (format "#x%x" x) (format "?%c" x)))
     (t x)))
 
@@ -581,7 +576,7 @@ failed."
 Returns nil if they are."
   (if (not (equal (type-of a) (type-of b)))
       `(different-types ,a ,b)
-    (etypecase a
+    (cl-etypecase a
       (cons
        (let ((a-proper-p (ert--proper-list-p a))
              (b-proper-p (ert--proper-list-p b)))
@@ -593,19 +588,19 @@ Returns nil if they are."
                                                       ,a ,b
                                                       first-mismatch-at
                                                       ,(ert--mismatch a b))
-                 (loop for i from 0
-                       for ai in a
-                       for bi in b
-                       for xi = (ert--explain-equal-rec ai bi)
-                       do (when xi (return `(list-elt ,i ,xi)))
-                       finally (assert (equal a b) t)))
+                 (cl-loop for i from 0
+                          for ai in a
+                          for bi in b
+                          for xi = (ert--explain-equal-rec ai bi)
+                          do (when xi (cl-return `(list-elt ,i ,xi)))
+                          finally (cl-assert (equal a b) t)))
              (let ((car-x (ert--explain-equal-rec (car a) (car b))))
                (if car-x
                    `(car ,car-x)
                  (let ((cdr-x (ert--explain-equal-rec (cdr a) (cdr b))))
                    (if cdr-x
                        `(cdr ,cdr-x)
-                     (assert (equal a b) t)
+                     (cl-assert (equal a b) t)
                      nil))))))))
       (array (if (not (equal (length a) (length b)))
                  `(arrays-of-different-length ,(length a) ,(length b)
@@ -613,12 +608,12 @@ Returns nil if they are."
                                               ,@(unless (char-table-p a)
                                                   `(first-mismatch-at
                                                     ,(ert--mismatch a b))))
-               (loop for i from 0
-                     for ai across a
-                     for bi across b
-                     for xi = (ert--explain-equal-rec ai bi)
-                     do (when xi (return `(array-elt ,i ,xi)))
-                     finally (assert (equal a b) t))))
+               (cl-loop for i from 0
+                        for ai across a
+                        for bi across b
+                        for xi = (ert--explain-equal-rec ai bi)
+                        do (when xi (cl-return `(array-elt ,i ,xi)))
+                        finally (cl-assert (equal a b) t))))
       (atom (if (not (equal a b))
                 (if (and (symbolp a) (symbolp b) (string= a b))
                     `(different-symbols-with-the-same-name ,a ,b)
@@ -637,10 +632,10 @@ Returns nil if they are."
 
 (defun ert--significant-plist-keys (plist)
   "Return the keys of PLIST that have non-null values, in order."
-  (assert (zerop (mod (length plist) 2)) t)
-  (loop for (key value . rest) on plist by #'cddr
-        unless (or (null value) (memq key accu)) collect key into accu
-        finally (return accu)))
+  (cl-assert (zerop (mod (length plist) 2)) t)
+  (cl-loop for (key value . rest) on plist by #'cddr
+           unless (or (null value) (memq key accu)) collect key into accu
+           finally (cl-return accu)))
 
 (defun ert--plist-difference-explanation (a b)
   "Return a programmer-readable explanation of why A and B are different plists.
@@ -648,8 +643,8 @@ Returns nil if they are."
 Returns nil if they are equivalent, i.e., have the same value for
 each key, where absent values are treated as nil.  The order of
 key/value pairs in each list does not matter."
-  (assert (zerop (mod (length a) 2)) t)
-  (assert (zerop (mod (length b) 2)) t)
+  (cl-assert (zerop (mod (length a) 2)) t)
+  (cl-assert (zerop (mod (length b) 2)) t)
   ;; Normalizing the plists would be another way to do this but it
   ;; requires a total ordering on all lisp objects (since any object
   ;; is valid as a text property key).  Perhaps defining such an
@@ -659,21 +654,21 @@ key/value pairs in each list does not matter."
          (keys-b (ert--significant-plist-keys b))
          (keys-in-a-not-in-b (ert--set-difference-eq keys-a keys-b))
          (keys-in-b-not-in-a (ert--set-difference-eq keys-b keys-a)))
-    (flet ((explain-with-key (key)
-             (let ((value-a (plist-get a key))
-                   (value-b (plist-get b key)))
-               (assert (not (equal value-a value-b)) t)
-               `(different-properties-for-key
-                 ,key ,(ert--explain-equal-including-properties value-a
-                                                                value-b)))))
+    (cl-flet ((explain-with-key (key)
+                (let ((value-a (plist-get a key))
+                      (value-b (plist-get b key)))
+                  (cl-assert (not (equal value-a value-b)) t)
+                  `(different-properties-for-key
+                    ,key ,(ert--explain-equal-including-properties value-a
+                                                                   value-b)))))
       (cond (keys-in-a-not-in-b
-             (explain-with-key (first keys-in-a-not-in-b)))
+             (explain-with-key (car keys-in-a-not-in-b)))
             (keys-in-b-not-in-a
-             (explain-with-key (first keys-in-b-not-in-a)))
+             (explain-with-key (car keys-in-b-not-in-a)))
             (t
-             (loop for key in keys-a
-                   when (not (equal (plist-get a key) (plist-get b key)))
-                   return (explain-with-key key)))))))
+             (cl-loop for key in keys-a
+                      when (not (equal (plist-get a key) (plist-get b key)))
+                      return (explain-with-key key)))))))
 
 (defun ert--abbreviate-string (s len suffixp)
   "Shorten string S to at most LEN chars.
@@ -697,29 +692,30 @@ Returns a programmer-readable explanation of why A and B are not
 `ert-equal-including-properties', or nil if they are."
   (if (not (equal a b))
       (ert--explain-equal a b)
-    (assert (stringp a) t)
-    (assert (stringp b) t)
-    (assert (eql (length a) (length b)) t)
-    (loop for i from 0 to (length a)
-          for props-a = (text-properties-at i a)
-          for props-b = (text-properties-at i b)
-          for difference = (ert--plist-difference-explanation props-a props-b)
-          do (when difference
-               (return `(char ,i ,(substring-no-properties a i (1+ i))
-                              ,difference
-                              context-before
-                              ,(ert--abbreviate-string
-                                (substring-no-properties a 0 i)
-                                10 t)
-                              context-after
-                              ,(ert--abbreviate-string
-                                (substring-no-properties a (1+ i))
-                                10 nil))))
-          ;; TODO(ohler): Get `equal-including-properties' fixed in
-          ;; Emacs, delete `ert-equal-including-properties', and
-          ;; re-enable this assertion.
-          ;;finally (assert (equal-including-properties a b) t)
-          )))
+    (cl-assert (stringp a) t)
+    (cl-assert (stringp b) t)
+    (cl-assert (eql (length a) (length b)) t)
+    (cl-loop for i from 0 to (length a)
+             for props-a = (text-properties-at i a)
+             for props-b = (text-properties-at i b)
+             for difference = (ert--plist-difference-explanation
+                               props-a props-b)
+             do (when difference
+                  (cl-return `(char ,i ,(substring-no-properties a i (1+ i))
+                                    ,difference
+                                    context-before
+                                    ,(ert--abbreviate-string
+                                      (substring-no-properties a 0 i)
+                                      10 t)
+                                    context-after
+                                    ,(ert--abbreviate-string
+                                      (substring-no-properties a (1+ i))
+                                      10 nil))))
+             ;; TODO(ohler): Get `equal-including-properties' fixed in
+             ;; Emacs, delete `ert-equal-including-properties', and
+             ;; re-enable this assertion.
+             ;;finally (cl-assert (equal-including-properties a b) t)
+             )))
 (put 'ert-equal-including-properties
      'ert-explainer
      'ert--explain-equal-including-properties)
@@ -734,8 +730,8 @@ Returns a programmer-readable explanation of why A and B are not
 
 Bound dynamically.  This is a list of (PREFIX . MESSAGE) pairs.")
 
-(defmacro* ert-info ((message-form &key ((:prefix prefix-form) "Info: "))
-                     &body body)
+(cl-defmacro ert-info ((message-form &key ((:prefix prefix-form) "Info: "))
+                       &body body)
   "Evaluate MESSAGE-FORM and BODY, and report the message if BODY fails.
 
 To be used within ERT tests.  MESSAGE-FORM should evaluate to a
@@ -755,18 +751,19 @@ and is displayed in front of the value of MESSAGE-FORM."
   "Non-nil means enter debugger when a test fails or terminates with an error.")
 
 ;; The data structures that represent the result of running a test.
-(defstruct ert-test-result
+(cl-defstruct ert-test-result
   (messages nil)
   (should-forms nil)
   )
-(defstruct (ert-test-passed (:include ert-test-result)))
-(defstruct (ert-test-result-with-condition (:include ert-test-result))
-  (condition (assert nil))
-  (backtrace (assert nil))
-  (infos (assert nil)))
-(defstruct (ert-test-quit (:include ert-test-result-with-condition)))
-(defstruct (ert-test-failed (:include ert-test-result-with-condition)))
-(defstruct (ert-test-aborted-with-non-local-exit (:include ert-test-result)))
+(cl-defstruct (ert-test-passed (:include ert-test-result)))
+(cl-defstruct (ert-test-result-with-condition (:include ert-test-result))
+  (condition (cl-assert nil))
+  (backtrace (cl-assert nil))
+  (infos (cl-assert nil)))
+(cl-defstruct (ert-test-quit (:include ert-test-result-with-condition)))
+(cl-defstruct (ert-test-failed (:include ert-test-result-with-condition)))
+(cl-defstruct (ert-test-aborted-with-non-local-exit
+               (:include ert-test-result)))
 
 
 (defun ert--record-backtrace ()
@@ -779,7 +776,7 @@ and is displayed in front of the value of MESSAGE-FORM."
   ;; `ert-results-pop-to-backtrace-for-test-at-point' given that we
   ;; already have `ert-results-rerun-test-debugging-errors-at-point'.
   ;; For batch use, however, printing the backtrace may be useful.
-  (loop
+  (cl-loop
    ;; 6 is the number of frames our own debugger adds (when
    ;; compiled; more when interpreted).  FIXME: Need to describe a
    ;; procedure for determining this constant.
@@ -796,33 +793,33 @@ and is displayed in front of the value of MESSAGE-FORM."
         (print-level 8)
         (print-length 50))
     (dolist (frame backtrace)
-      (ecase (first frame)
+      (cl-ecase (car frame)
         ((nil)
          ;; Special operator.
-         (destructuring-bind (special-operator &rest arg-forms)
+         (cl-destructuring-bind (special-operator &rest arg-forms)
              (cdr frame)
            (insert
-            (format "  %S\n" (list* special-operator arg-forms)))))
+            (format "  %S\n" (cons special-operator arg-forms)))))
         ((t)
          ;; Function call.
-         (destructuring-bind (fn &rest args) (cdr frame)
+         (cl-destructuring-bind (fn &rest args) (cdr frame)
            (insert (format "  %S(" fn))
-           (loop for firstp = t then nil
-                 for arg in args do
-                 (unless firstp
-                   (insert " "))
-                 (insert (format "%S" arg)))
+           (cl-loop for firstp = t then nil
+                    for arg in args do
+                    (unless firstp
+                      (insert " "))
+                    (insert (format "%S" arg)))
            (insert ")\n")))))))
 
 ;; A container for the state of the execution of a single test and
 ;; environment data needed during its execution.
-(defstruct ert--test-execution-info
-  (test (assert nil))
-  (result (assert nil))
+(cl-defstruct ert--test-execution-info
+  (test (cl-assert nil))
+  (result (cl-assert nil))
   ;; A thunk that may be called when RESULT has been set to its final
   ;; value and test execution should be terminated.  Should not
   ;; return.
-  (exit-continuation (assert nil))
+  (exit-continuation (cl-assert nil))
   ;; The binding of `debugger' outside of the execution of the test.
   next-debugger
   ;; The binding of `ert-debug-on-error' that is in effect for the
@@ -831,7 +828,7 @@ and is displayed in front of the value of MESSAGE-FORM."
   ;; don't remember whether this feature is important.)
   ert-debug-on-error)
 
-(defun ert--run-test-debugger (info debugger-args)
+(defun ert--run-test-debugger (info args)
   "During a test run, `debugger' is bound to a closure that calls this function.
 
 This function records failures and errors and either terminates
@@ -839,21 +836,21 @@ the test silently or calls the interactive debugger, as
 appropriate.
 
 INFO is the ert--test-execution-info corresponding to this test
-run.  DEBUGGER-ARGS are the arguments to `debugger'."
-  (destructuring-bind (first-debugger-arg &rest more-debugger-args)
-      debugger-args
-    (ecase first-debugger-arg
+run.  ARGS are the arguments to `debugger'."
+  (cl-destructuring-bind (first-debugger-arg &rest more-debugger-args)
+      args
+    (cl-ecase first-debugger-arg
       ((lambda debug t exit nil)
-       (apply (ert--test-execution-info-next-debugger info) debugger-args))
+       (apply (ert--test-execution-info-next-debugger info) args))
       (error
-       (let* ((condition (first more-debugger-args))
-              (type (case (car condition)
+       (let* ((condition (car more-debugger-args))
+              (type (cl-case (car condition)
                       ((quit) 'quit)
                       (otherwise 'failed)))
               (backtrace (ert--record-backtrace))
               (infos (reverse ert--infos)))
          (setf (ert--test-execution-info-result info)
-               (ecase type
+               (cl-ecase type
                  (quit
                   (make-ert-test-quit :condition condition
                                       :backtrace backtrace
@@ -862,41 +859,44 @@ run.  DEBUGGER-ARGS are the arguments to `debugger'."
                   (make-ert-test-failed :condition condition
                                         :backtrace backtrace
                                         :infos infos))))
-         ;; Work around Emacs' heuristic (in eval.c) for detecting
+         ;; Work around Emacs's heuristic (in eval.c) for detecting
          ;; errors in the debugger.
-         (incf num-nonmacro-input-events)
+         (cl-incf num-nonmacro-input-events)
          ;; FIXME: We should probably implement more fine-grained
          ;; control a la non-t `debug-on-error' here.
          (cond
           ((ert--test-execution-info-ert-debug-on-error info)
-           (apply (ert--test-execution-info-next-debugger info) debugger-args))
+           (apply (ert--test-execution-info-next-debugger info) args))
           (t))
          (funcall (ert--test-execution-info-exit-continuation info)))))))
 
-(defun ert--run-test-internal (ert-test-execution-info)
-  "Low-level function to run a test according to ERT-TEST-EXECUTION-INFO.
+(defun ert--run-test-internal (test-execution-info)
+  "Low-level function to run a test according to TEST-EXECUTION-INFO.
 
 This mainly sets up debugger-related bindings."
-  (lexical-let ((info ert-test-execution-info))
-    (setf (ert--test-execution-info-next-debugger info) debugger
-          (ert--test-execution-info-ert-debug-on-error info) ert-debug-on-error)
-    (catch 'ert--pass
-      ;; For now, each test gets its own temp buffer and its own
-      ;; window excursion, just to be safe.  If this turns out to be
-      ;; too expensive, we can remove it.
-      (with-temp-buffer
-        (save-window-excursion
-          (let ((debugger (lambda (&rest debugger-args)
-                            (ert--run-test-debugger info debugger-args)))
-                (debug-on-error t)
-                (debug-on-quit t)
-                ;; FIXME: Do we need to store the old binding of this
-                ;; and consider it in `ert--run-test-debugger'?
-                (debug-ignored-errors nil)
-                (ert--infos '()))
-            (funcall (ert-test-body (ert--test-execution-info-test info))))))
-      (ert-pass))
-    (setf (ert--test-execution-info-result info) (make-ert-test-passed)))
+  (setf (ert--test-execution-info-next-debugger test-execution-info) debugger
+        (ert--test-execution-info-ert-debug-on-error test-execution-info)
+        ert-debug-on-error)
+  (catch 'ert--pass
+    ;; For now, each test gets its own temp buffer and its own
+    ;; window excursion, just to be safe.  If this turns out to be
+    ;; too expensive, we can remove it.
+    (with-temp-buffer
+      (save-window-excursion
+        (let ((debugger (lambda (&rest args)
+                          (ert--run-test-debugger test-execution-info
+                                                  args)))
+              (debug-on-error t)
+              (debug-on-quit t)
+              ;; FIXME: Do we need to store the old binding of this
+              ;; and consider it in `ert--run-test-debugger'?
+              (debug-ignored-errors nil)
+              (ert--infos '()))
+          (funcall (ert-test-body (ert--test-execution-info-test
+                                   test-execution-info))))))
+    (ert-pass))
+  (setf (ert--test-execution-info-result test-execution-info)
+        (make-ert-test-passed))
   nil)
 
 (defun ert--force-message-log-buffer-truncation ()
@@ -934,18 +934,18 @@ The elements are of type `ert-test'.")
 
 Returns the result and stores it in ERT-TEST's `most-recent-result' slot."
   (setf (ert-test-most-recent-result ert-test) nil)
-  (block error
-    (lexical-let ((begin-marker
-                   (with-current-buffer (get-buffer-create "*Messages*")
-                     (set-marker (make-marker) (point-max)))))
+  (cl-block error
+    (let ((begin-marker
+           (with-current-buffer (get-buffer-create "*Messages*")
+             (set-marker (make-marker) (point-max)))))
       (unwind-protect
-          (lexical-let ((info (make-ert--test-execution-info
-                               :test ert-test
-                               :result
-                               (make-ert-test-aborted-with-non-local-exit)
-                               :exit-continuation (lambda ()
-                                                    (return-from error nil))))
-                        (should-form-accu (list)))
+          (let ((info (make-ert--test-execution-info
+                       :test ert-test
+                       :result
+                       (make-ert-test-aborted-with-non-local-exit)
+                       :exit-continuation (lambda ()
+                                            (cl-return-from error nil))))
+                (should-form-accu (list)))
             (unwind-protect
                 (let ((ert--should-execution-observer
                        (lambda (form-description)
@@ -987,32 +987,32 @@ t -- Always matches.
                            RESULT."
   ;; It would be easy to add `member' and `eql' types etc., but I
   ;; haven't bothered yet.
-  (etypecase result-type
+  (cl-etypecase result-type
     ((member nil) nil)
     ((member t) t)
     ((member :failed) (ert-test-failed-p result))
     ((member :passed) (ert-test-passed-p result))
     (cons
-     (destructuring-bind (operator &rest operands) result-type
-       (ecase operator
+     (cl-destructuring-bind (operator &rest operands) result-type
+       (cl-ecase operator
          (and
-          (case (length operands)
+          (cl-case (length operands)
             (0 t)
             (t
-             (and (ert-test-result-type-p result (first operands))
-                  (ert-test-result-type-p result `(and ,@(rest operands)))))))
+             (and (ert-test-result-type-p result (car operands))
+                  (ert-test-result-type-p result `(and ,@(cdr operands)))))))
          (or
-          (case (length operands)
+          (cl-case (length operands)
             (0 nil)
             (t
-             (or (ert-test-result-type-p result (first operands))
-                 (ert-test-result-type-p result `(or ,@(rest operands)))))))
+             (or (ert-test-result-type-p result (car operands))
+                 (ert-test-result-type-p result `(or ,@(cdr operands)))))))
          (not
-          (assert (eql (length operands) 1))
-          (not (ert-test-result-type-p result (first operands))))
+          (cl-assert (eql (length operands) 1))
+          (not (ert-test-result-type-p result (car operands))))
          (satisfies
-          (assert (eql (length operands) 1))
-          (funcall (first operands) result)))))))
+          (cl-assert (eql (length operands) 1))
+          (funcall (car operands) result)))))))
 
 (defun ert-test-result-expected-p (test result)
   "Return non-nil if TEST's expected result type matches RESULT."
@@ -1053,9 +1053,9 @@ set implied by them without checking whether it is really
 contained in UNIVERSE."
   ;; This code needs to match the etypecase in
   ;; `ert-insert-human-readable-selector'.
-  (etypecase selector
+  (cl-etypecase selector
     ((member nil) nil)
-    ((member t) (etypecase universe
+    ((member t) (cl-etypecase universe
                   (list universe)
                   ((member t) (ert-select-tests "" universe))))
     ((member :new) (ert-select-tests
@@ -1083,7 +1083,7 @@ contained in UNIVERSE."
                          universe))
     ((member :unexpected) (ert-select-tests `(not :expected) universe))
     (string
-     (etypecase universe
+     (cl-etypecase universe
        ((member t) (mapcar #'ert-get-test
                            (apropos-internal selector #'ert-test-boundp)))
        (list (ert--remove-if-not (lambda (test)
@@ -1093,51 +1093,51 @@ contained in UNIVERSE."
                                  universe))))
     (ert-test (list selector))
     (symbol
-     (assert (ert-test-boundp selector))
+     (cl-assert (ert-test-boundp selector))
      (list (ert-get-test selector)))
     (cons
-     (destructuring-bind (operator &rest operands) selector
-       (ecase operator
+     (cl-destructuring-bind (operator &rest operands) selector
+       (cl-ecase operator
          (member
           (mapcar (lambda (purported-test)
-                    (etypecase purported-test
-                      (symbol (assert (ert-test-boundp purported-test))
+                    (cl-etypecase purported-test
+                      (symbol (cl-assert (ert-test-boundp purported-test))
                               (ert-get-test purported-test))
                       (ert-test purported-test)))
                   operands))
          (eql
-          (assert (eql (length operands) 1))
+          (cl-assert (eql (length operands) 1))
           (ert-select-tests `(member ,@operands) universe))
          (and
           ;; Do these definitions of AND, NOT and OR satisfy de
           ;; Morgan's laws?  Should they?
-          (case (length operands)
+          (cl-case (length operands)
             (0 (ert-select-tests 't universe))
-            (t (ert-select-tests `(and ,@(rest operands))
-                                 (ert-select-tests (first operands)
+            (t (ert-select-tests `(and ,@(cdr operands))
+                                 (ert-select-tests (car operands)
                                                    universe)))))
          (not
-          (assert (eql (length operands) 1))
+          (cl-assert (eql (length operands) 1))
           (let ((all-tests (ert-select-tests 't universe)))
             (ert--set-difference all-tests
-                                 (ert-select-tests (first operands)
+                                 (ert-select-tests (car operands)
                                                    all-tests))))
          (or
-          (case (length operands)
+          (cl-case (length operands)
             (0 (ert-select-tests 'nil universe))
-            (t (ert--union (ert-select-tests (first operands) universe)
-                           (ert-select-tests `(or ,@(rest operands))
+            (t (ert--union (ert-select-tests (car operands) universe)
+                           (ert-select-tests `(or ,@(cdr operands))
                                              universe)))))
          (tag
-          (assert (eql (length operands) 1))
-          (let ((tag (first operands)))
+          (cl-assert (eql (length operands) 1))
+          (let ((tag (car operands)))
             (ert-select-tests `(satisfies
                                 ,(lambda (test)
                                    (member tag (ert-test-tags test))))
                               universe)))
          (satisfies
-          (assert (eql (length operands) 1))
-          (ert--remove-if-not (first operands)
+          (cl-assert (eql (length operands) 1))
+          (ert--remove-if-not (car operands)
                               (ert-select-tests 't universe))))))))
 
 (defun ert--insert-human-readable-selector (selector)
@@ -1146,26 +1146,27 @@ contained in UNIVERSE."
   ;; `backtrace' slot of the result objects in the
   ;; `most-recent-result' slots of test case objects in (eql ...) or
   ;; (member ...) selectors.
-  (labels ((rec (selector)
-             ;; This code needs to match the etypecase in `ert-select-tests'.
-             (etypecase selector
-               ((or (member nil t
-                            :new :failed :passed
-                            :expected :unexpected)
-                    string
-                    symbol)
-                selector)
-               (ert-test
-                (if (ert-test-name selector)
-                    (make-symbol (format "<%S>" (ert-test-name selector)))
-                  (make-symbol "<unnamed test>")))
-               (cons
-                (destructuring-bind (operator &rest operands) selector
-                  (ecase operator
-                    ((member eql and not or)
-                     `(,operator ,@(mapcar #'rec operands)))
-                    ((member tag satisfies)
-                     selector)))))))
+  (cl-labels ((rec (selector)
+                ;; This code needs to match the etypecase in
+                ;; `ert-select-tests'.
+                (cl-etypecase selector
+                  ((or (member nil t
+                               :new :failed :passed
+                               :expected :unexpected)
+                       string
+                       symbol)
+                   selector)
+                  (ert-test
+                   (if (ert-test-name selector)
+                       (make-symbol (format "<%S>" (ert-test-name selector)))
+                     (make-symbol "<unnamed test>")))
+                  (cons
+                   (cl-destructuring-bind (operator &rest operands) selector
+                     (cl-ecase operator
+                       ((member eql and not or)
+                        `(,operator ,@(mapcar #'rec operands)))
+                       ((member tag satisfies)
+                        selector)))))))
     (insert (format "%S" (rec selector)))))
 
 
@@ -1182,21 +1183,21 @@ contained in UNIVERSE."
 ;; that corresponds to this run in order to be able to update the
 ;; statistics correctly when a test is re-run interactively and has a
 ;; different result than before.
-(defstruct ert--stats
-  (selector (assert nil))
+(cl-defstruct ert--stats
+  (selector (cl-assert nil))
   ;; The tests, in order.
-  (tests (assert nil) :type vector)
+  (tests (cl-assert nil) :type vector)
   ;; A map of test names (or the test objects themselves for unnamed
   ;; tests) to indices into the `tests' vector.
-  (test-map (assert nil) :type hash-table)
+  (test-map (cl-assert nil) :type hash-table)
   ;; The results of the tests during this run, in order.
-  (test-results (assert nil) :type vector)
+  (test-results (cl-assert nil) :type vector)
   ;; The start times of the tests, in order, as reported by
   ;; `current-time'.
-  (test-start-times (assert nil) :type vector)
+  (test-start-times (cl-assert nil) :type vector)
   ;; The end times of the tests, in order, as reported by
   ;; `current-time'.
-  (test-end-times (assert nil) :type vector)
+  (test-end-times (cl-assert nil) :type vector)
   (passed-expected 0)
   (passed-unexpected 0)
   (failed-expected 0)
@@ -1246,21 +1247,25 @@ Also changes the counters in STATS to match."
          (results (ert--stats-test-results stats))
          (old-test (aref tests pos))
          (map (ert--stats-test-map stats)))
-    (flet ((update (d)
-             (if (ert-test-result-expected-p (aref tests pos)
-                                             (aref results pos))
-                 (etypecase (aref results pos)
-                   (ert-test-passed (incf (ert--stats-passed-expected stats) d))
-                   (ert-test-failed (incf (ert--stats-failed-expected stats) d))
-                   (null)
-                   (ert-test-aborted-with-non-local-exit)
-                   (ert-test-quit))
-               (etypecase (aref results pos)
-                 (ert-test-passed (incf (ert--stats-passed-unexpected stats) d))
-                 (ert-test-failed (incf (ert--stats-failed-unexpected stats) d))
-                 (null)
-                 (ert-test-aborted-with-non-local-exit)
-                 (ert-test-quit)))))
+    (cl-flet ((update (d)
+                (if (ert-test-result-expected-p (aref tests pos)
+                                                (aref results pos))
+                    (cl-etypecase (aref results pos)
+                      (ert-test-passed
+                       (cl-incf (ert--stats-passed-expected stats) d))
+                      (ert-test-failed
+                       (cl-incf (ert--stats-failed-expected stats) d))
+                      (null)
+                      (ert-test-aborted-with-non-local-exit)
+                      (ert-test-quit))
+                  (cl-etypecase (aref results pos)
+                    (ert-test-passed
+                     (cl-incf (ert--stats-passed-unexpected stats) d))
+                    (ert-test-failed
+                     (cl-incf (ert--stats-failed-unexpected stats) d))
+                    (null)
+                    (ert-test-aborted-with-non-local-exit)
+                    (ert-test-quit)))))
       ;; Adjust counters to remove the result that is currently in stats.
       (update -1)
       ;; Put new test and result into stats.
@@ -1278,11 +1283,11 @@ Also changes the counters in STATS to match."
 SELECTOR is the selector that was used to select TESTS."
   (setq tests (ert--coerce-to-vector tests))
   (let ((map (make-hash-table :size (length tests))))
-    (loop for i from 0
-          for test across tests
-          for key = (ert--stats-test-key test) do
-          (assert (not (gethash key map)))
-          (setf (gethash key map) i))
+    (cl-loop for i from 0
+             for test across tests
+             for key = (ert--stats-test-key test) do
+             (cl-assert (not (gethash key map)))
+             (setf (gethash key map) i))
     (make-ert--stats :selector selector
                      :tests tests
                      :test-map map
@@ -1324,8 +1329,8 @@ SELECTOR is the selector that was used to select TESTS."
             (force-mode-line-update)
             (unwind-protect
                 (progn
-                  (loop for test in tests do
-                        (ert-run-or-rerun-test stats test listener))
+                  (cl-loop for test in tests do
+                           (ert-run-or-rerun-test stats test listener))
                   (setq abortedp nil))
               (setf (ert--stats-aborted-p stats) abortedp)
               (setf (ert--stats-end-time stats) (current-time))
@@ -1349,7 +1354,7 @@ SELECTOR is the selector that was used to select TESTS."
   "Return a character that represents the test result RESULT.
 
 EXPECTEDP specifies whether the result was expected."
-  (let ((s (etypecase result
+  (let ((s (cl-etypecase result
              (ert-test-passed ".P")
              (ert-test-failed "fF")
              (null "--")
@@ -1361,7 +1366,7 @@ EXPECTEDP specifies whether the result was expected."
   "Return a string that represents the test result RESULT.
 
 EXPECTEDP specifies whether the result was expected."
-  (let ((s (etypecase result
+  (let ((s (cl-etypecase result
              (ert-test-passed '("passed" "PASSED"))
              (ert-test-failed '("failed" "FAILED"))
              (null '("unknown" "UNKNOWN"))
@@ -1383,9 +1388,9 @@ Ensures a final newline is inserted."
   "Insert `ert-info' infos from RESULT into current buffer.
 
 RESULT must be an `ert-test-result-with-condition'."
-  (check-type result ert-test-result-with-condition)
+  (cl-check-type result ert-test-result-with-condition)
   (dolist (info (ert-test-result-with-condition-infos result))
-    (destructuring-bind (prefix . message) info
+    (cl-destructuring-bind (prefix . message) info
       (let ((begin (point))
             (indentation (make-string (+ (length prefix) 4) ?\s))
             (end nil))
@@ -1405,7 +1410,7 @@ RESULT must be an `ert-test-result-with-condition'."
 ;;; Running tests in batch mode.
 
 (defvar ert-batch-backtrace-right-margin 70
-  "*The maximum line length for printing backtraces in `ert-run-tests-batch'.")
+  "The maximum line length for printing backtraces in `ert-run-tests-batch'.")
 
 ;;;###autoload
 (defun ert-run-tests-batch (&optional selector)
@@ -1421,14 +1426,14 @@ Returns the stats object."
   (ert-run-tests
    selector
    (lambda (event-type &rest event-args)
-     (ecase event-type
+     (cl-ecase event-type
        (run-started
-        (destructuring-bind (stats) event-args
+        (cl-destructuring-bind (stats) event-args
           (message "Running %s tests (%s)"
                    (length (ert--stats-tests stats))
                    (ert--format-time-iso8601 (ert--stats-start-time stats)))))
        (run-ended
-        (destructuring-bind (stats abortedp) event-args
+        (cl-destructuring-bind (stats abortedp) event-args
           (let ((unexpected (ert-stats-completed-unexpected stats))
                 (expected-failures (ert--stats-failed-expected stats)))
             (message "\n%sRan %s tests, %s results as expected%s (%s)%s\n"
@@ -1446,19 +1451,19 @@ Returns the stats object."
                        (format "\n%s expected failures" expected-failures)))
             (unless (zerop unexpected)
               (message "%s unexpected results:" unexpected)
-              (loop for test across (ert--stats-tests stats)
-                    for result = (ert-test-most-recent-result test) do
-                    (when (not (ert-test-result-expected-p test result))
-                      (message "%9s  %S"
-                               (ert-string-for-test-result result nil)
-                               (ert-test-name test))))
+              (cl-loop for test across (ert--stats-tests stats)
+                       for result = (ert-test-most-recent-result test) do
+                       (when (not (ert-test-result-expected-p test result))
+                         (message "%9s  %S"
+                                  (ert-string-for-test-result result nil)
+                                  (ert-test-name test))))
               (message "%s" "")))))
        (test-started
         )
        (test-ended
-        (destructuring-bind (stats test result) event-args
+        (cl-destructuring-bind (stats test result) event-args
           (unless (ert-test-result-expected-p test result)
-            (etypecase result
+            (cl-etypecase result
               (ert-test-passed
                (message "Test %S passed unexpectedly" (ert-test-name test)))
               (ert-test-result-with-condition
@@ -1484,7 +1489,7 @@ Returns the stats object."
                    (ert--pp-with-indentation-and-newline
                     (ert-test-result-with-condition-condition result)))
                  (goto-char (1- (point-max)))
-                 (assert (looking-at "\n"))
+                 (cl-assert (looking-at "\n"))
                  (delete-char 1)
                  (message "Test %S condition:" (ert-test-name test))
                  (message "%s" (buffer-string))))
@@ -1532,7 +1537,7 @@ the tests)."
       (1 font-lock-keyword-face nil t)
       (2 font-lock-function-name-face nil t)))))
 
-(defun* ert--remove-from-list (list-var element &key key test)
+(cl-defun ert--remove-from-list (list-var element &key key test)
   "Remove ELEMENT from the value of LIST-VAR if present.
 
 This can be used as an inverse of `add-to-list'."
@@ -1557,7 +1562,7 @@ If ADD-DEFAULT-TO-PROMPT is non-nil, PROMPT will be modified to
 include the default, if any.
 
 Signals an error if no test name was read."
-  (etypecase default
+  (cl-etypecase default
     (string (let ((symbol (intern-soft default)))
               (unless (and symbol (ert-test-boundp symbol))
                 (setq default nil))))
@@ -1614,11 +1619,11 @@ Nothing more than an interactive interface to `ert-make-test-unbound'."
 ;;; Display of test progress and results.
 
 ;; An entry in the results buffer ewoc.  There is one entry per test.
-(defstruct ert--ewoc-entry
-  (test (assert nil))
+(cl-defstruct ert--ewoc-entry
+  (test (cl-assert nil))
   ;; If the result of this test was expected, its ewoc entry is hidden
   ;; initially.
-  (hidden-p (assert nil))
+  (hidden-p (cl-assert nil))
   ;; An ewoc entry may be collapsed to hide details such as the error
   ;; condition.
   ;;
@@ -1694,7 +1699,7 @@ Also sets `ert--results-progress-bar-button-begin'."
                           ((ert--stats-current-test stats) 'running)
                           ((ert--stats-end-time stats) 'finished)
                           (t 'preparing))))
-         (ecase state
+         (cl-ecase state
            (preparing
             (insert ""))
            (aborted
@@ -1705,12 +1710,12 @@ Also sets `ert--results-progress-bar-button-begin'."
                   (t
                    (insert "Aborted."))))
            (running
-            (assert (ert--stats-current-test stats))
+            (cl-assert (ert--stats-current-test stats))
             (insert "Running test: ")
             (ert-insert-test-name-button (ert-test-name
                                           (ert--stats-current-test stats))))
            (finished
-            (assert (not (ert--stats-current-test stats)))
+            (cl-assert (not (ert--stats-current-test stats)))
             (insert "Finished.")))
          (insert "\n")
          (if (ert--stats-end-time stats)
@@ -1813,7 +1818,7 @@ non-nil, returns the face for expected results.."
 (defun ert-face-for-stats (stats)
   "Return a face that represents STATS."
   (cond ((ert--stats-aborted-p stats) 'nil)
-        ((plusp (ert-stats-completed-unexpected stats))
+        ((cl-plusp (ert-stats-completed-unexpected stats))
          (ert-face-for-test-result nil))
         ((eql (ert-stats-completed-expected stats) (ert-stats-total stats))
          (ert-face-for-test-result t))
@@ -1824,7 +1829,7 @@ non-nil, returns the face for expected results.."
   (let* ((test (ert--ewoc-entry-test entry))
          (stats ert--results-stats)
          (result (let ((pos (ert--stats-test-pos stats test)))
-                   (assert pos)
+                   (cl-assert pos)
                    (aref (ert--stats-test-results stats) pos)))
          (hiddenp (ert--ewoc-entry-hidden-p entry))
          (expandedp (ert--ewoc-entry-expanded-p entry))
@@ -1850,7 +1855,7 @@ non-nil, returns the face for expected results.."
                         (ert--string-first-line (ert-test-documentation test))
                         'font-lock-face 'font-lock-doc-face)
                        "\n"))
-             (etypecase result
+             (cl-etypecase result
                (ert-test-passed
                 (if (ert-test-result-expected-p test result)
                     (insert "    passed\n")
@@ -1908,9 +1913,10 @@ BUFFER-NAME, if non-nil, is the buffer name to use."
                (make-string (ert-stats-total stats)
                             (ert-char-for-test-result nil t)))
           (set (make-local-variable 'ert--results-listener) listener)
-          (loop for test across (ert--stats-tests stats) do
-                (ewoc-enter-last ewoc
-                                 (make-ert--ewoc-entry :test test :hidden-p t)))
+          (cl-loop for test across (ert--stats-tests stats) do
+                   (ewoc-enter-last ewoc
+                                    (make-ert--ewoc-entry :test test
+                                                          :hidden-p t)))
           (ert--results-update-ewoc-hf ert--results-ewoc ert--results-stats)
           (goto-char (1- (point-max)))
           buffer)))))
@@ -1945,21 +1951,21 @@ and how to display message."
                                  default nil))
          nil))
   (unless message-fn (setq message-fn 'message))
-  (lexical-let ((output-buffer-name output-buffer-name)
-                buffer
-                listener
-                (message-fn message-fn))
+  (let ((output-buffer-name output-buffer-name)
+        buffer
+        listener
+        (message-fn message-fn))
     (setq listener
           (lambda (event-type &rest event-args)
-            (ecase event-type
+            (cl-ecase event-type
               (run-started
-               (destructuring-bind (stats) event-args
+               (cl-destructuring-bind (stats) event-args
                  (setq buffer (ert--setup-results-buffer stats
                                                          listener
                                                          output-buffer-name))
                  (pop-to-buffer buffer)))
               (run-ended
-               (destructuring-bind (stats abortedp) event-args
+               (cl-destructuring-bind (stats abortedp) event-args
                  (funcall message-fn
                           "%sRan %s tests, %s results were as expected%s"
                           (if (not abortedp)
@@ -1976,19 +1982,19 @@ and how to display message."
                                                       ert--results-ewoc)
                                                     stats)))
               (test-started
-               (destructuring-bind (stats test) event-args
+               (cl-destructuring-bind (stats test) event-args
                  (with-current-buffer buffer
                    (let* ((ewoc ert--results-ewoc)
                           (pos (ert--stats-test-pos stats test))
                           (node (ewoc-nth ewoc pos)))
-                     (assert node)
+                     (cl-assert node)
                      (setf (ert--ewoc-entry-test (ewoc-data node)) test)
                      (aset ert--results-progress-bar-string pos
                            (ert-char-for-test-result nil t))
                      (ert--results-update-stats-display-maybe ewoc stats)
                      (ewoc-invalidate ewoc node)))))
               (test-ended
-               (destructuring-bind (stats test result) event-args
+               (cl-destructuring-bind (stats test result) event-args
                  (with-current-buffer buffer
                    (let* ((ewoc ert--results-ewoc)
                           (pos (ert--stats-test-pos stats test))
@@ -2020,28 +2026,28 @@ and how to display message."
 (define-derived-mode ert-results-mode special-mode "ERT-Results"
   "Major mode for viewing results of ERT test runs.")
 
-(loop for (key binding) in
-      '(;; Stuff that's not in the menu.
-        ("\t" forward-button)
-        ([backtab] backward-button)
-        ("j" ert-results-jump-between-summary-and-result)
-        ("L" ert-results-toggle-printer-limits-for-test-at-point)
-        ("n" ert-results-next-test)
-        ("p" ert-results-previous-test)
-        ;; Stuff that is in the menu.
-        ("R" ert-results-rerun-all-tests)
-        ("r" ert-results-rerun-test-at-point)
-        ("d" ert-results-rerun-test-at-point-debugging-errors)
-        ("." ert-results-find-test-at-point-other-window)
-        ("b" ert-results-pop-to-backtrace-for-test-at-point)
-        ("m" ert-results-pop-to-messages-for-test-at-point)
-        ("l" ert-results-pop-to-should-forms-for-test-at-point)
-        ("h" ert-results-describe-test-at-point)
-        ("D" ert-delete-test)
-        ("T" ert-results-pop-to-timings)
-        )
-      do
-      (define-key ert-results-mode-map key binding))
+(cl-loop for (key binding) in
+         '( ;; Stuff that's not in the menu.
+           ("\t" forward-button)
+           ([backtab] backward-button)
+           ("j" ert-results-jump-between-summary-and-result)
+           ("L" ert-results-toggle-printer-limits-for-test-at-point)
+           ("n" ert-results-next-test)
+           ("p" ert-results-previous-test)
+           ;; Stuff that is in the menu.
+           ("R" ert-results-rerun-all-tests)
+           ("r" ert-results-rerun-test-at-point)
+           ("d" ert-results-rerun-test-at-point-debugging-errors)
+           ("." ert-results-find-test-at-point-other-window)
+           ("b" ert-results-pop-to-backtrace-for-test-at-point)
+           ("m" ert-results-pop-to-messages-for-test-at-point)
+           ("l" ert-results-pop-to-should-forms-for-test-at-point)
+           ("h" ert-results-describe-test-at-point)
+           ("D" ert-delete-test)
+           ("T" ert-results-pop-to-timings)
+           )
+         do
+         (define-key ert-results-mode-map key binding))
 
 (easy-menu-define ert-results-mode-menu ert-results-mode-map
   "Menu for `ert-results-mode'."
@@ -2121,15 +2127,15 @@ To be used in the ERT results buffer."
 EWOC-FN specifies the direction and should be either `ewoc-prev'
 or `ewoc-next'.  If there are no more nodes in that direction, an
 error is signaled with the message ERROR-MESSAGE."
-  (loop
+  (cl-loop
    (setq node (funcall ewoc-fn ert--results-ewoc node))
    (when (null node)
      (error "%s" error-message))
    (unless (ert--ewoc-entry-hidden-p (ewoc-data node))
      (goto-char (ewoc-location node))
-     (return))))
+     (cl-return))))
 
-(defun ert--results-expand-collapse-button-action (button)
+(defun ert--results-expand-collapse-button-action (_button)
   "Expand or collapse the test node BUTTON belongs to."
   (let* ((ewoc ert--results-ewoc)
          (node (save-excursion
@@ -2158,11 +2164,11 @@ To be used in the ERT results buffer."
 (defun ert--ewoc-position (ewoc node)
   ;; checkdoc-order: nil
   "Return the position of NODE in EWOC, or nil if NODE is not in EWOC."
-  (loop for i from 0
-        for node-here = (ewoc-nth ewoc 0) then (ewoc-next ewoc node-here)
-        do (when (eql node node-here)
-             (return i))
-        finally (return nil)))
+  (cl-loop for i from 0
+           for node-here = (ewoc-nth ewoc 0) then (ewoc-next ewoc node-here)
+           do (when (eql node node-here)
+                (cl-return i))
+           finally (cl-return nil)))
 
 (defun ert-results-jump-between-summary-and-result ()
   "Jump back and forth between the test run summary and individual test results.
@@ -2210,7 +2216,7 @@ To be used in the ERT results buffer."
   "Return the test at point, or nil.
 
 To be used in the ERT results buffer."
-  (assert (eql major-mode 'ert-results-mode))
+  (cl-assert (eql major-mode 'ert-results-mode))
   (if (ert--results-test-node-or-null-at-point)
       (let* ((node (ert--results-test-node-at-point))
              (test (ert--ewoc-entry-test (ewoc-data node))))
@@ -2282,9 +2288,9 @@ definition."
          (point))
         ((eventp last-command-event)
          (posn-point (event-start last-command-event)))
-        (t (assert nil))))
+        (t (cl-assert nil))))
 
-(defun ert--results-progress-bar-button-action (button)
+(defun ert--results-progress-bar-button-action (_button)
   "Jump to details for the test represented by the character clicked in BUTTON."
   (goto-char (ert--button-action-position))
   (ert-results-jump-between-summary-and-result))
@@ -2294,7 +2300,7 @@ definition."
 
 To be used in the ERT results buffer."
   (interactive)
-  (assert (eql major-mode 'ert-results-mode))
+  (cl-assert (eql major-mode 'ert-results-mode))
   (let ((selector (ert--stats-selector ert--results-stats)))
     (ert-run-tests-interactively selector (buffer-name))))
 
@@ -2303,13 +2309,13 @@ To be used in the ERT results buffer."
 
 To be used in the ERT results buffer."
   (interactive)
-  (destructuring-bind (test redefinition-state)
+  (cl-destructuring-bind (test redefinition-state)
       (ert--results-test-at-point-allow-redefinition)
     (when (null test)
       (error "No test at point"))
     (let* ((stats ert--results-stats)
            (progress-message (format "Running %stest %S"
-                                     (ecase redefinition-state
+                                     (cl-ecase redefinition-state
                                        ((nil) "")
                                        (redefined "new definition of ")
                                        (deleted "deleted "))
@@ -2350,7 +2356,7 @@ To be used in the ERT results buffer."
          (stats ert--results-stats)
          (pos (ert--stats-test-pos stats test))
          (result (aref (ert--stats-test-results stats) pos)))
-    (etypecase result
+    (cl-etypecase result
       (ert-test-passed (error "Test passed, no backtrace available"))
       (ert-test-result-with-condition
        (let ((backtrace (ert-test-result-with-condition-backtrace result))
@@ -2408,13 +2414,14 @@ To be used in the ERT results buffer."
         (ert-simple-view-mode)
         (if (null (ert-test-result-should-forms result))
             (insert "\n(No should forms during this test.)\n")
-          (loop for form-description in (ert-test-result-should-forms result)
-                for i from 1 do
-                (insert "\n")
-                (insert (format "%s: " i))
-                (let ((begin (point)))
-                  (ert--pp-with-indentation-and-newline form-description)
-                  (ert--make-xrefs-region begin (point)))))
+          (cl-loop for form-description
+                   in (ert-test-result-should-forms result)
+                   for i from 1 do
+                   (insert "\n")
+                   (insert (format "%s: " i))
+                   (let ((begin (point)))
+                     (ert--pp-with-indentation-and-newline form-description)
+                     (ert--make-xrefs-region begin (point)))))
         (goto-char (point-min))
         (insert "`should' forms executed during test `")
         (ert-insert-test-name-button (ert-test-name test))
@@ -2443,17 +2450,16 @@ To be used in the ERT results buffer."
 To be used in the ERT results buffer."
   (interactive)
   (let* ((stats ert--results-stats)
-         (start-times (ert--stats-test-start-times stats))
-         (end-times (ert--stats-test-end-times stats))
          (buffer (get-buffer-create "*ERT timings*"))
-         (data (loop for test across (ert--stats-tests stats)
-                     for start-time across (ert--stats-test-start-times stats)
-                     for end-time across (ert--stats-test-end-times stats)
-                     collect (list test
-                                   (float-time (subtract-time end-time
-                                                              start-time))))))
+         (data (cl-loop for test across (ert--stats-tests stats)
+                        for start-time across (ert--stats-test-start-times
+                                               stats)
+                        for end-time across (ert--stats-test-end-times stats)
+                        collect (list test
+                                      (float-time (subtract-time
+                                                   end-time start-time))))))
     (setq data (sort data (lambda (a b)
-                            (> (second a) (second b)))))
+                            (> (cl-second a) (cl-second b)))))
     (pop-to-buffer buffer)
     (let ((inhibit-read-only t))
       (buffer-disable-undo)
@@ -2462,13 +2468,13 @@ To be used in the ERT results buffer."
       (if (null data)
           (insert "(No data)\n")
         (insert (format "%-3s  %8s %8s\n" "" "time" "cumul"))
-        (loop for (test time) in data
-              for cumul-time = time then (+ cumul-time time)
-              for i from 1 do
-              (let ((begin (point)))
-                (insert (format "%3s: %8.3f %8.3f " i time cumul-time))
-                (ert-insert-test-name-button (ert-test-name test))
-                (insert "\n"))))
+        (cl-loop for (test time) in data
+                 for cumul-time = time then (+ cumul-time time)
+                 for i from 1 do
+                 (progn
+                   (insert (format "%3s: %8.3f %8.3f " i time cumul-time))
+                   (ert-insert-test-name-button (ert-test-name test))
+                   (insert "\n"))))
       (goto-char (point-min))
       (insert "Tests by run time (seconds):\n\n")
       (forward-line 1))))
@@ -2481,7 +2487,7 @@ To be used in the ERT results buffer."
     (error "Requires Emacs 24"))
   (let (test-name
         test-definition)
-    (etypecase test-or-test-name
+    (cl-etypecase test-or-test-name
       (symbol (setq test-name test-or-test-name
                     test-definition (ert-get-test test-or-test-name)))
       (ert-test (setq test-name (ert-test-name test-or-test-name)
diff --git a/lisp/emacs-lisp/ewoc.el b/lisp/emacs-lisp/ewoc.el
index a71f3c7244c..5de3da65174 100644
--- a/lisp/emacs-lisp/ewoc.el
+++ b/lisp/emacs-lisp/ewoc.el
@@ -1,6 +1,6 @@
-;;; ewoc.el --- utility to maintain a view of a list of objects in a buffer
+;;; ewoc.el --- utility to maintain a view of a list of objects in a buffer  -*- lexical-binding: t -*-
 
-;; Copyright (C) 1991-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1991-2012 Free Software Foundation, Inc.
 
 ;; Author: Per Cederqvist <ceder@lysator.liu.se>
 ;;	Inge Wallin <inge@lysator.liu.se>
@@ -26,7 +26,7 @@
 ;;; Commentary:
 
 ;; Ewoc Was Once Cookie
-;; But now it's Emacs' Widget for Object Collections
+;; But now it's Emacs's Widget for Object Collections
 
 ;; As the name implies this derives from the `cookie' package (part
 ;; of Elib).  The changes are pervasive though mostly superficial:
@@ -96,11 +96,11 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
 
 ;; The doubly linked list is implemented as a circular list with a dummy
 ;; node first and last. The dummy node is used as "the dll".
-(defstruct (ewoc--node
+(cl-defstruct (ewoc--node
 	    (:type vector)		;ewoc--node-nth needs this
             (:constructor nil)
 	    (:constructor ewoc--node-create (start-marker data)))
@@ -140,7 +140,7 @@ and (ewoc--node-nth dll -1) returns the last node."
 
 ;;; The ewoc data type
 
-(defstruct (ewoc
+(cl-defstruct (ewoc
 	    (:constructor nil)
 	    (:constructor ewoc--create (buffer pretty-printer dll))
 	    (:conc-name ewoc--))
@@ -216,10 +216,9 @@ NODE and leaving the new node's start there.  Return the new node."
     (ewoc--adjust m (point) R dll)))
 
 (defun ewoc--wrap (func)
-  (lexical-let ((ewoc--user-pp func))
-    (lambda (data)
-      (funcall ewoc--user-pp data)
-      (insert "\n"))))
+  (lambda (data)
+    (funcall func data)
+    (insert "\n")))
 
 
 ;;; ===========================================================================
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index 070faca8d91..e1e153d9117 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -1,6 +1,6 @@
 ;;; find-func.el --- find the definition of the Emacs Lisp function near point
 
-;; Copyright (C) 1997, 1999, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999, 2001-2012 Free Software Foundation, Inc.
 
 ;; Author: Jens Petersen <petersen@kurims.kyoto-u.ac.jp>
 ;; Maintainer: petersen@kurims.kyoto-u.ac.jp
@@ -347,8 +347,7 @@ in `load-path'."
     (if aliases
 	(message "%s" aliases))
     (let ((library
-	   (cond ((eq (car-safe def) 'autoload)
-		  (nth 1 def))
+	   (cond ((autoloadp def) (nth 1 def))
 		 ((subrp def)
 		  (if lisp-only
 		      (error "%s is a built-in function" function))
diff --git a/lisp/emacs-lisp/find-gc.el b/lisp/emacs-lisp/find-gc.el
index 1de38625243..39797fb5433 100644
--- a/lisp/emacs-lisp/find-gc.el
+++ b/lisp/emacs-lisp/find-gc.el
@@ -1,6 +1,6 @@
 ;;; find-gc.el --- detect functions that call the garbage collector
 
-;; Copyright (C) 1992, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2012 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 
diff --git a/lisp/emacs-lisp/float-sup.el b/lisp/emacs-lisp/float-sup.el
index 7e40fdad352..f7d6cdc3b75 100644
--- a/lisp/emacs-lisp/float-sup.el
+++ b/lisp/emacs-lisp/float-sup.el
@@ -1,6 +1,6 @@
 ;;; float-sup.el --- define some constants useful for floating point numbers.
 
-;; Copyright (C) 1985-1987, 2001-2011  Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 2001-2012  Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: internal
@@ -28,13 +28,9 @@
 ;; Provide an easy hook to tell if we are running with floats or not.
 ;; Define pi and e via math-lib calls (much less prone to killer typos).
 (defconst float-pi (* 4 (atan 1)) "The value of Pi (3.1415926...).")
-(progn
-  ;; Simulate a defconst that doesn't declare the variable dynamically bound.
-  (setq-default pi float-pi)
-  (put 'pi 'variable-documentation
-       "Obsolete since Emacs-23.3.  Use `float-pi' instead.")
-  (put 'pi 'risky-local-variable t)
-  (push 'pi current-load-list))
+(defconst pi float-pi
+  "Obsolete since Emacs-23.3.  Use `float-pi' instead.")
+(internal-make-var-non-special 'pi)
 
 (defconst float-e (exp 1) "The value of e (2.7182818...).")
 
diff --git a/lisp/emacs-lisp/generic.el b/lisp/emacs-lisp/generic.el
index 770fe01f91c..80b6122822e 100644
--- a/lisp/emacs-lisp/generic.el
+++ b/lisp/emacs-lisp/generic.el
@@ -1,6 +1,6 @@
 ;;; generic.el --- defining simple major modes with comment and font-lock
 ;;
-;; Copyright (C) 1997, 1999, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999, 2001-2012 Free Software Foundation, Inc.
 ;;
 ;; Author:  Peter Breton <pbreton@cs.umb.edu>
 ;; Created: Fri Sep 27 1996
@@ -97,10 +97,11 @@
 ;; Internal Variables
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(define-obsolete-variable-alias 'generic-font-lock-defaults
+  'generic-font-lock-keywords "22.1")
 (defvar generic-font-lock-keywords nil
   "Keywords for `font-lock-defaults' in a generic mode.")
 (make-variable-buffer-local 'generic-font-lock-keywords)
-(define-obsolete-variable-alias 'generic-font-lock-defaults 'generic-font-lock-keywords "22.1")
 
 ;;;###autoload
 (defvar generic-mode-list nil
@@ -150,7 +151,8 @@ mode hook `MODE-hook'.
 See the file generic-x.el for some examples of `define-generic-mode'."
   (declare (debug (sexp def-form def-form def-form form def-form
 			[&optional stringp] &rest [keywordp form]))
-	   (indent 1))
+	   (indent 1)
+           (doc-string 7))
 
   ;; Backward compatibility.
   (when (eq (car-safe mode) 'quote)
diff --git a/lisp/emacs-lisp/gulp.el b/lisp/emacs-lisp/gulp.el
index eca5470fd69..859b7d32b9e 100644
--- a/lisp/emacs-lisp/gulp.el
+++ b/lisp/emacs-lisp/gulp.el
@@ -1,6 +1,6 @@
 ;;; gulp.el --- ask for updates for Lisp packages
 
-;; Copyright (C) 1996, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2012 Free Software Foundation, Inc.
 
 ;; Author: Sam Shteingold <shteingd@math.ucla.edu>
 ;; Maintainer: FSF
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
new file mode 100644
index 00000000000..5488330a1a4
--- /dev/null
+++ b/lisp/emacs-lisp/gv.el
@@ -0,0 +1,482 @@
+;;; gv.el --- generalized variables  -*- lexical-binding: t -*-
+
+;; Copyright (C) 2012  Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+;; Keywords: extensions
+;; Package: emacs
+
+;; 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 3 of the License, 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.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This is a re-implementation of the setf machinery using a different
+;; underlying approach than the one used earlier in CL, which was based on
+;; define-setf-expander.
+;; `define-setf-expander' makes every "place-expander" return a 5-tuple
+;;   (VARS VALUES STORES GETTER SETTER)
+;; where STORES is a list with a single variable (Common-Lisp allows multiple
+;; variables for use with multiple-return-values, but this is rarely used and
+;; not applicable to Elisp).
+;; It basically says that GETTER is an expression that returns the place's
+;; value, and (lambda STORES SETTER) is an expression that assigns the value(s)
+;; passed to that function to the place, and that you need to wrap the whole
+;; thing within a `(let* ,(zip VARS VALUES) ...).
+;;
+;; Instead, we use here a higher-order approach: instead
+;; of a 5-tuple, a place-expander returns a function.
+;; If you think about types, the old approach return things of type
+;;    {vars: List Var, values: List Exp,
+;;     stores: List Var, getter: Exp, setter: Exp}
+;; whereas the new approach returns a function of type
+;;    (do: ((getter: Exp, setter: ((store: Exp) -> Exp)) -> Exp)) -> Exp.
+;; You can get the new function from the old 5-tuple with something like:
+;;    (lambda (do)
+;;       `(let* ,(zip VARS VALUES)
+;;          (funcall do GETTER (lambda ,STORES ,SETTER))))
+;; You can't easily do the reverse, because this new approach is more
+;; expressive than the old one, so we can't provide a backward-compatible
+;; get-setf-method.
+;;
+;; While it may seem intimidating for people not used to higher-order
+;; functions, you will quickly see that its use (especially with the
+;; `gv-letplace' macro) is actually much easier and more elegant than the old
+;; approach which is clunky and often leads to unreadable code.
+
+;; Food for thought: the syntax of places does not actually conflict with the
+;; pcase patterns.  The `cons' gv works just like a `(,a . ,b) pcase
+;; pattern, and actually the `logand' gv is even closer since it should
+;; arguably fail when trying to set a value outside of the mask.
+;; Generally, places are used for destructors (gethash, aref, car, ...)
+;; whereas pcase patterns are used for constructors (backquote, constants,
+;; vectors, ...).
+
+;;; Code:
+
+(require 'macroexp)
+
+;; What we call a "gvar" is basically a function of type "(getter * setter ->
+;; code) -> code", where "getter" is code and setter is "code -> code".
+
+;; (defvar gv--macro-environment nil
+;;   "Macro expanders for generalized variables.")
+
+;;;###autoload
+(defun gv-get (place do)
+  "Build the code that applies DO to PLACE.
+PLACE must be a valid generalized variable.
+DO must be a function; it will be called with 2 arguments: GETTER and SETTER,
+where GETTER is a (copyable) Elisp expression that returns the value of PLACE,
+and SETTER is a function which returns the code to set PLACE when called
+with a (not necessarily copyable) Elisp expression that returns the value to
+set it to.
+DO must return an Elisp expression."
+  (if (symbolp place)
+      (funcall do place (lambda (v) `(setq ,place ,v)))
+    (let* ((head (car place))
+           (gf (function-get head 'gv-expander 'autoload)))
+      (if gf (apply gf do (cdr place))
+        (let ((me (macroexpand place    ;FIXME: expand one step at a time!
+                               ;; (append macroexpand-all-environment
+                               ;;         gv--macro-environment)
+                               macroexpand-all-environment)))
+          (if (and (eq me place) (get head 'compiler-macro))
+              ;; Expand compiler macros: this takes care of all the accessors
+              ;; defined via cl-defsubst, such as cXXXr and defstruct slots.
+              (setq me (apply (get head 'compiler-macro) place (cdr place))))
+          (if (and (eq me place) (fboundp head)
+                   (symbolp (symbol-function head)))
+              ;; Follow aliases.
+              (setq me (cons (symbol-function head) (cdr place))))
+          (if (eq me place)
+              (error "%S is not a valid place expression" place)
+            (gv-get me do)))))))
+
+;;;###autoload
+(defmacro gv-letplace (vars place &rest body)
+  "Build the code manipulating the generalized variable PLACE.
+GETTER will be bound to a copyable expression that returns the value
+of PLACE.
+SETTER will be bound to a function that takes an expression V and returns
+a new expression that sets PLACE to V.
+BODY should return some Elisp expression E manipulating PLACE via GETTER
+and SETTER.
+The returned value will then be an Elisp expression that first evaluates
+all the parts of PLACE that can be evaluated and then runs E.
+
+\(fn (GETTER SETTER) PLACE &rest BODY)"
+  (declare (indent 2) (debug (sexp form body)))
+  `(gv-get ,place (lambda ,vars ,@body)))
+
+;; Different ways to declare a generalized variable.
+;;;###autoload
+(defmacro gv-define-expander (name handler)
+  "Use HANDLER to handle NAME as a generalized var.
+NAME is a symbol: the name of a function, macro, or special form.
+HANDLER is a function which takes an argument DO followed by the same
+arguments as NAME.  DO is a function as defined in `gv-get'."
+  (declare (indent 1) (debug (sexp form)))
+  ;; Use eval-and-compile so the method can be used in the same file as it
+  ;; is defined.
+  ;; FIXME: Just like byte-compile-macro-environment, we should have something
+  ;; like byte-compile-symbolprop-environment so as to handle these things
+  ;; cleanly without affecting the running Emacs.
+  `(eval-and-compile (put ',name 'gv-expander ,handler)))
+
+;;;###autoload
+(defun gv--defun-declaration (symbol name args handler &optional fix)
+  `(progn
+     ;; No need to autoload this part, since gv-get will auto-load the
+     ;; function's definition before checking the `gv-expander' property.
+     :autoload-end
+     ,(pcase (cons symbol handler)
+        (`(gv-expander . (lambda (,do) . ,body))
+         `(gv-define-expander ,name (lambda (,do ,@args) ,@body)))
+        (`(gv-expander . ,(pred symbolp))
+         `(gv-define-expander ,name #',handler))
+        (`(gv-setter . (lambda (,store) . ,body))
+         `(gv-define-setter ,name (,store ,@args) ,@body))
+        (`(gv-setter . ,(pred symbolp))
+         `(gv-define-simple-setter ,name ,handler ,fix))
+        ;; (`(expand ,expander) `(gv-define-expand ,name ,expander))
+        (_ (message "Unknown %s declaration %S" symbol handler) nil))))
+
+;;;###autoload
+(push `(gv-expander ,(apply-partially #'gv--defun-declaration 'gv-expander))
+      defun-declarations-alist)
+;;;###autoload
+(push `(gv-setter ,(apply-partially #'gv--defun-declaration 'gv-setter))
+      defun-declarations-alist)
+
+;; (defmacro gv-define-expand (name expander)
+;;   "Use EXPANDER to handle NAME as a generalized var.
+;; NAME is a symbol: the name of a function, macro, or special form.
+;; EXPANDER is a function that will be called as a macro-expander to reduce
+;; uses of NAME to some other generalized variable."
+;;   (declare (debug (sexp form)))
+;;   `(eval-and-compile
+;;      (if (not (boundp 'gv--macro-environment))
+;;          (setq gv--macro-environment nil))
+;;      (push (cons ',name ,expander) gv--macro-environment)))
+
+(defun gv--defsetter (name setter do args &optional vars)
+  "Helper function used by code generated by `gv-define-setter'.
+NAME is the name of the getter function.
+SETTER is a function that generates the code for the setter.
+NAME accept ARGS as arguments and SETTER accepts (NEWVAL . ARGS).
+VARS is used internally for recursive calls."
+  (if (null args)
+      (let ((vars (nreverse vars)))
+        (funcall do `(,name ,@vars) (lambda (v) (apply setter v vars))))
+    ;; FIXME: Often it would be OK to skip this `let', but in general,
+    ;; `do' may have all kinds of side-effects.
+    (macroexp-let2 nil v (car args)
+      (gv--defsetter name setter do (cdr args) (cons v vars)))))
+
+;;;###autoload
+(defmacro gv-define-setter (name arglist &rest body)
+  "Define a setter method for generalized variable NAME.
+This macro is an easy-to-use substitute for `gv-define-expander' that works
+well for simple place forms.
+Assignments of VAL to (NAME ARGS...) are expanded by binding the argument
+forms (VAL ARGS...) according to ARGLIST, then executing BODY, which must
+return a Lisp form that does the assignment.
+The first arg in ARGLIST (the one that receives VAL) receives an expression
+which can do arbitrary things, whereas the other arguments are all guaranteed
+to be pure and copyable.  Example use:
+  (gv-define-setter aref (v a i) `(aset ,a ,i ,v))"
+  (declare (indent 2) (debug (&define name sexp body)))
+  `(gv-define-expander ,name
+     (lambda (do &rest args)
+       (gv--defsetter ',name (lambda ,arglist ,@body) do args))))
+
+;;;###autoload
+(defmacro gv-define-simple-setter (name setter &optional fix-return)
+  "Define a simple setter method for generalized variable NAME.
+This macro is an easy-to-use substitute for `gv-define-expander' that works
+well for simple place forms.  Assignments of VAL to (NAME ARGS...) are
+turned into calls of the form (SETTER ARGS... VAL).
+
+If FIX-RETURN is non-nil, then SETTER is not assumed to return VAL and
+instead the assignment is turned into something equivalent to
+  \(let ((temp VAL))
+    (SETTER ARGS... temp)
+    temp)
+so as to preserve the semantics of `setf'."
+  (declare (debug (sexp (&or symbolp lambda-expr) &optional sexp)))
+  `(gv-define-setter ,name (val &rest args)
+     ,(if fix-return
+          `(macroexp-let2 nil v val
+             `(progn
+                (,',setter ,@(append args (list v)))
+                ,v))
+        `(cons ',setter (append args (list val))))))
+
+;;; Typical operations on generalized variables.
+
+;;;###autoload
+(defmacro setf (&rest args)
+  "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 (cadr x) y) is equivalent to (setcar (cdr x) y).
+The return value is the last VAL in the list.
+
+\(fn PLACE VAL PLACE VAL ...)"
+  (declare (debug (&rest [gv-place form])))
+  (if (and args (null (cddr args)))
+      (let ((place (pop args))
+            (val (car args)))
+        (gv-letplace (_getter setter) place
+          (funcall setter val)))
+    (let ((sets nil))
+      (while args (push `(setf ,(pop args) ,(pop args)) sets))
+      (cons 'progn (nreverse sets)))))
+
+;; (defmacro gv-pushnew! (val place)
+;;   "Like `gv-push!' but only adds VAL if it's not yet in PLACE.
+;; Presence is checked with `member'.
+;; The return value is unspecified."
+;;   (declare (debug (form gv-place)))
+;;   (macroexp-let2 macroexp-copyable-p v val
+;;     (gv-letplace (getter setter) place
+;;       `(if (member ,v ,getter) nil
+;;          ,(funcall setter `(cons ,v ,getter))))))
+
+;; (defmacro gv-inc! (place &optional val)
+;;   "Increment PLACE by VAL (default to 1)."
+;;   (declare (debug (gv-place &optional form)))
+;;   (gv-letplace (getter setter) place
+;;     (funcall setter `(+ ,getter ,(or val 1)))))
+
+;; (defmacro gv-dec! (place &optional val)
+;;   "Decrement PLACE by VAL (default to 1)."
+;;   (declare (debug (gv-place &optional form)))
+;;   (gv-letplace (getter setter) place
+;;     (funcall setter `(- ,getter ,(or val 1)))))
+
+;; For Edebug, the idea is to let Edebug instrument gv-places just like it does
+;; for normal expressions, and then give it a gv-expander to DTRT.
+;; Maybe this should really be in edebug.el rather than here.
+
+;; Autoload this `put' since a user might use C-u C-M-x on an expression
+;; containing a non-trivial `push' even before gv.el was loaded.
+;;;###autoload
+(put 'gv-place 'edebug-form-spec 'edebug-match-form)
+;; CL did the equivalent of:
+;;(gv-define-macroexpand edebug-after (lambda (before index place) place))
+
+(put 'edebug-after 'gv-expander
+     (lambda (do before index place)
+       (gv-letplace (getter setter) place
+         (funcall do `(edebug-after ,before ,index ,getter)
+                  setter))))
+
+;;; The common generalized variables.
+
+(gv-define-simple-setter aref aset)
+(gv-define-simple-setter car setcar)
+(gv-define-simple-setter cdr setcdr)
+;; FIXME: add compiler-macros for `cXXr' instead!
+(gv-define-setter caar (val x) `(setcar (car ,x) ,val))
+(gv-define-setter cadr (val x) `(setcar (cdr ,x) ,val))
+(gv-define-setter cdar (val x) `(setcdr (car ,x) ,val))
+(gv-define-setter cddr (val x) `(setcdr (cdr ,x) ,val))
+(gv-define-setter elt (store seq n)
+  `(if (listp ,seq) (setcar (nthcdr ,n ,seq) ,store)
+     (aset ,seq ,n ,store)))
+(gv-define-simple-setter get put)
+(gv-define-setter gethash (val k h &optional _d) `(puthash ,k ,val ,h))
+
+;; (gv-define-expand nth (lambda (idx list) `(car (nthcdr ,idx ,list))))
+(put 'nth 'gv-expander
+     (lambda (do idx list)
+       (macroexp-let2 nil c `(nthcdr ,idx ,list)
+         (funcall do `(car ,c) (lambda (v) `(setcar ,c ,v))))))
+(gv-define-simple-setter symbol-function fset)
+(gv-define-simple-setter symbol-plist setplist)
+(gv-define-simple-setter symbol-value set)
+
+(put 'nthcdr 'gv-expander
+     (lambda (do n place)
+       (macroexp-let2 nil idx n
+         (gv-letplace (getter setter) place
+           (funcall do `(nthcdr ,idx ,getter)
+                    (lambda (v) `(if (<= ,idx 0) ,(funcall setter v)
+                              (setcdr (nthcdr (1- ,idx) ,getter) ,v))))))))
+
+;;; Elisp-specific generalized variables.
+
+(gv-define-simple-setter default-value set-default)
+(gv-define-simple-setter frame-parameter set-frame-parameter 'fix)
+(gv-define-simple-setter terminal-parameter set-terminal-parameter)
+(gv-define-simple-setter keymap-parent set-keymap-parent)
+(gv-define-simple-setter match-data set-match-data 'fix)
+(gv-define-simple-setter overlay-get overlay-put)
+(gv-define-setter overlay-start (store ov)
+  `(progn (move-overlay ,ov ,store (overlay-end ,ov)) ,store))
+(gv-define-setter overlay-end (store ov)
+  `(progn (move-overlay ,ov (overlay-start ,ov) ,store) ,store))
+(gv-define-simple-setter process-buffer set-process-buffer)
+(gv-define-simple-setter process-filter set-process-filter)
+(gv-define-simple-setter process-sentinel set-process-sentinel)
+(gv-define-simple-setter process-get process-put)
+(gv-define-simple-setter window-buffer set-window-buffer)
+(gv-define-simple-setter window-display-table set-window-display-table 'fix)
+(gv-define-simple-setter window-dedicated-p set-window-dedicated-p)
+(gv-define-simple-setter window-hscroll set-window-hscroll)
+(gv-define-simple-setter window-parameter set-window-parameter)
+(gv-define-simple-setter window-point set-window-point)
+(gv-define-simple-setter window-start set-window-start)
+
+;;; Some occasionally handy extensions.
+
+;; While several of the "places" below are not terribly useful for direct use,
+;; they can show up as the output of the macro expansion of reasonable places,
+;; such as struct-accessors.
+
+(put 'progn 'gv-expander
+     (lambda (do &rest exps)
+       (let ((start (butlast exps))
+             (end (car (last exps))))
+         (if (null start) (gv-get end do)
+           `(progn ,@start ,(gv-get end do))))))
+
+(let ((let-expander
+       (lambda (letsym)
+         (lambda (do bindings &rest body)
+           `(,letsym ,bindings
+                     ,@(macroexp-unprogn
+                        (gv-get (macroexp-progn body) do)))))))
+  (put 'let 'gv-expander (funcall let-expander 'let))
+  (put 'let* 'gv-expander (funcall let-expander 'let*)))
+
+(put 'if 'gv-expander
+     (lambda (do test then &rest else)
+       (if (or (not lexical-binding)  ;The other code requires lexical-binding.
+               (macroexp-small-p (funcall do 'dummy (lambda (_) 'dummy))))
+           ;; This duplicates the `do' code, which is a problem if that
+           ;; code is large, but otherwise results in more efficient code.
+           `(if ,test ,(gv-get then do)
+              ,@(macroexp-unprogn (gv-get (macroexp-progn else) do)))
+         (let ((v (make-symbol "v")))
+           (macroexp-let2 nil
+               gv `(if ,test ,(gv-letplace (getter setter) then
+                                `(cons (lambda () ,getter)
+                                       (lambda (,v) ,(funcall setter v))))
+                     ,(gv-letplace (getter setter) (macroexp-progn else)
+                        `(cons (lambda () ,getter)
+                               (lambda (,v) ,(funcall setter v)))))
+             (funcall do `(funcall (car ,gv))
+                      (lambda (v) `(funcall (cdr ,gv) ,v))))))))
+
+(put 'cond 'gv-expander
+     (lambda (do &rest branches)
+       (if (or (not lexical-binding)  ;The other code requires lexical-binding.
+               (macroexp-small-p (funcall do 'dummy (lambda (_) 'dummy))))
+           ;; This duplicates the `do' code, which is a problem if that
+           ;; code is large, but otherwise results in more efficient code.
+           `(cond
+             ,@(mapcar (lambda (branch)
+                         (if (cdr branch)
+                             (cons (car branch)
+                                   (macroexp-unprogn
+                                    (gv-get (macroexp-progn (cdr branch)) do)))
+                           (gv-get (car branch) do)))
+                       branches))
+         (let ((v (make-symbol "v")))
+           (macroexp-let2 nil
+               gv `(cond
+                    ,@(mapcar
+                       (lambda (branch)
+                         (if (cdr branch)
+                             `(,(car branch)
+                               ,@(macroexp-unprogn
+                                  (gv-letplace (getter setter)
+                                      (macroexp-progn (cdr branch))
+                                    `(cons (lambda () ,getter)
+                                           (lambda (,v) ,(funcall setter v))))))
+                           (gv-letplace (getter setter)
+                               (car branch)
+                             `(cons (lambda () ,getter)
+                                    (lambda (,v) ,(funcall setter v))))))
+                       branches))
+             (funcall do `(funcall (car ,gv))
+                      (lambda (v) `(funcall (cdr ,gv) ,v))))))))
+
+;;; Even more debatable extensions.
+
+(put 'cons 'gv-expander
+     (lambda (do a d)
+       (gv-letplace (agetter asetter) a
+         (gv-letplace (dgetter dsetter) d
+           (funcall do
+                    `(cons ,agetter ,dgetter)
+                    (lambda (v) `(progn
+                              ,(funcall asetter `(car ,v))
+                              ,(funcall dsetter `(cdr ,v)))))))))
+
+(put 'logand 'gv-expander
+     (lambda (do place &rest masks)
+       (gv-letplace (getter setter) place
+         (macroexp-let2 macroexp-copyable-p
+             mask (if (cdr masks) `(logand ,@masks) (car masks))
+           (funcall
+            do `(logand ,getter ,mask)
+            (lambda (v)
+              (funcall setter
+                       `(logior (logand ,v ,mask)
+                                (logand ,getter (lognot ,mask))))))))))
+
+;;; References
+
+;;;###autoload
+(defmacro gv-ref (place)
+  "Return a reference to PLACE.
+This is like the `&' operator of the C language."
+  (gv-letplace (getter setter) place
+    `(cons (lambda () ,getter)
+           (lambda (gv--val) ,(funcall setter 'gv--val)))))
+
+(defsubst gv-deref (ref)
+  "Dereference REF, returning the referenced value.
+This is like the `*' operator of the C language.
+REF must have been previously obtained with `gv-ref'."
+  (funcall (car ref)))
+;; Don't use `declare' because it seems to introduce circularity problems:
+;; Warning: Eager macro-expansion skipped due to cycle:
+;;  … => (load "gv.el") => (macroexpand-all (defsubst gv-deref …)) => (macroexpand (defun …)) => (load "gv.el")
+(gv-define-setter gv-deref (v ref) `(funcall (cdr ,ref) ,v))
+
+;;; Vaguely related definitions that should be moved elsewhere.
+
+;; (defun alist-get (key alist)
+;;   "Get the value associated to KEY in ALIST."
+;;   (declare
+;;    (gv-expander
+;;     (lambda (do)
+;;       (macroexp-let2 macroexp-copyable-p k key
+;;         (gv-letplace (getter setter) alist
+;;           (macroexp-let2 nil p `(assoc ,k ,getter)
+;;             (funcall do `(cdr ,p)
+;;                      (lambda (v)
+;;                        `(if ,p (setcdr ,p ,v)
+;;                           ,(funcall setter
+;;                                     `(cons (cons ,k ,v) ,getter)))))))))))
+;;   (cdr (assoc key alist)))
+
+(provide 'gv)
+;;; gv.el ends here
diff --git a/lisp/emacs-lisp/helper.el b/lisp/emacs-lisp/helper.el
index 113f5849364..e10cbdb3b6e 100644
--- a/lisp/emacs-lisp/helper.el
+++ b/lisp/emacs-lisp/helper.el
@@ -1,6 +1,6 @@
 ;;; helper.el --- utility help package supporting help in electric modes
 
-;; Copyright (C) 1985, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 2001-2012 Free Software Foundation, Inc.
 
 ;; Author: K. Shane Hartman
 ;; Maintainer: FSF
diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el
index 4d0cacf4ee1..f9a1c5dbf83 100644
--- a/lisp/emacs-lisp/lisp-mnt.el
+++ b/lisp/emacs-lisp/lisp-mnt.el
@@ -1,6 +1,6 @@
 ;;; lisp-mnt.el --- utility functions for Emacs Lisp maintainers
 
-;; Copyright (C) 1992, 1994, 1997, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1994, 1997, 2000-2012 Free Software Foundation, Inc.
 
 ;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
 ;; Maintainer: FSF
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 44e87e171d1..64aac4b81db 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -1,6 +1,6 @@
 ;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands
 
-;; Copyright (C) 1985-1986, 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1999-2012 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: lisp, languages
@@ -34,8 +34,14 @@
 (defvar font-lock-string-face)
 
 (defvar lisp-mode-abbrev-table nil)
+(define-abbrev-table 'lisp-mode-abbrev-table ()
+  "Abbrev table for Lisp mode.")
 
-(define-abbrev-table 'lisp-mode-abbrev-table ())
+(defvar emacs-lisp-mode-abbrev-table nil)
+(define-abbrev-table 'emacs-lisp-mode-abbrev-table ()
+  "Abbrev table for Emacs Lisp mode.
+It has `lisp-mode-abbrev-table' as its parent."
+  :parents (list lisp-mode-abbrev-table))
 
 (defvar emacs-lisp-mode-syntax-table
   (let ((table (make-syntax-table))
@@ -111,10 +117,15 @@
 	 (purecopy (concat "^\\s-*("
 			   (eval-when-compile
 			     (regexp-opt
-			      '("defvar" "defconst" "defconstant" "defcustom"
+			      '("defconst" "defconstant" "defcustom"
 				"defparameter" "define-symbol-macro") t))
 			   "\\s-+\\(\\(\\sw\\|\\s_\\)+\\)"))
 	 2)
+   ;; For `defvar', we ignore (defvar FOO) constructs.
+   (list (purecopy "Variables")
+	 (purecopy (concat "^\\s-*(defvar\\s-+\\(\\(\\sw\\|\\s_\\)+\\)"
+			   "[[:space:]\n]+[^)]"))
+	 1)
    (list (purecopy "Types")
 	 (purecopy (concat "^\\s-*("
 			   (eval-when-compile
@@ -129,35 +140,12 @@
 
 ;; This was originally in autoload.el and is still used there.
 (put 'autoload 'doc-string-elt 3)
-(put 'defun    'doc-string-elt 3)
-(put 'defun*    'doc-string-elt 3)
 (put 'defmethod 'doc-string-elt 3)
 (put 'defvar   'doc-string-elt 3)
-(put 'defcustom 'doc-string-elt 3)
-(put 'deftheme 'doc-string-elt 2)
-(put 'deftype 'doc-string-elt 3)
 (put 'defconst 'doc-string-elt 3)
-(put 'defmacro 'doc-string-elt 3)
-(put 'defmacro* 'doc-string-elt 3)
-(put 'defsubst 'doc-string-elt 3)
-(put 'defstruct 'doc-string-elt 2)
-(put 'define-skeleton 'doc-string-elt 2)
-(put 'define-derived-mode 'doc-string-elt 4)
-(put 'define-compilation-mode 'doc-string-elt 3)
-(put 'easy-mmode-define-minor-mode 'doc-string-elt 2)
-(put 'define-minor-mode 'doc-string-elt 2)
-(put 'easy-mmode-define-global-mode 'doc-string-elt 2)
-(put 'define-global-minor-mode 'doc-string-elt 2)
-(put 'define-globalized-minor-mode 'doc-string-elt 2)
-(put 'define-generic-mode 'doc-string-elt 7)
-(put 'define-ibuffer-filter 'doc-string-elt 2)
-(put 'define-ibuffer-op 'doc-string-elt 3)
-(put 'define-ibuffer-sorter 'doc-string-elt 2)
-(put 'lambda 'doc-string-elt 2)
 (put 'defalias 'doc-string-elt 3)
 (put 'defvaralias 'doc-string-elt 3)
 (put 'define-category 'doc-string-elt 2)
-(put 'define-overloadable-function 'doc-string-elt 3)
 
 (defvar lisp-doc-string-elt-property 'doc-string-elt
   "The symbol property that holds the docstring position info.")
@@ -175,7 +163,8 @@
                                   (goto-char listbeg)
                                   (and (looking-at "([ \t\n]*\\(\\(\\sw\\|\\s_\\)+\\)")
                                        (match-string 1)))))
-                 (docelt (and firstsym (get (intern-soft firstsym)
+                 (docelt (and firstsym
+                              (function-get (intern-soft firstsym)
                                             lisp-doc-string-elt-property))))
             (if (and docelt
                      ;; It's a string in a form that can have a docstring.
@@ -206,7 +195,6 @@ score-mode.el.  KEYWORDS-CASE-INSENSITIVE non-nil means that for
 font-lock keywords will not be case sensitive."
   (when lisp-syntax
     (set-syntax-table lisp-mode-syntax-table))
-  (setq local-abbrev-table lisp-mode-abbrev-table)
   (make-local-variable 'paragraph-ignore-fill-prefix)
   (setq paragraph-ignore-fill-prefix t)
   (make-local-variable 'fill-paragraph-function)
@@ -282,110 +270,111 @@ font-lock keywords will not be case sensitive."
     (define-key map "\e\t" 'completion-at-point)
     (define-key map "\e\C-x" 'eval-defun)
     (define-key map "\e\C-q" 'indent-pp-sexp)
-    (define-key map [menu-bar emacs-lisp] (cons (purecopy "Emacs-Lisp") menu-map))
-    (define-key menu-map [eldoc]
-      `(menu-item ,(purecopy "Auto-Display Documentation Strings") eldoc-mode
+    (bindings--define-key map [menu-bar emacs-lisp]
+      (cons "Emacs-Lisp" menu-map))
+    (bindings--define-key menu-map [eldoc]
+      '(menu-item "Auto-Display Documentation Strings" eldoc-mode
 		  :button (:toggle . (bound-and-true-p eldoc-mode))
-		  :help ,(purecopy "Display the documentation string for the item under cursor")))
-    (define-key menu-map [checkdoc]
-      `(menu-item ,(purecopy "Check Documentation Strings") checkdoc
-		  :help ,(purecopy "Check documentation strings for style requirements")))
-    (define-key menu-map [re-builder]
-      `(menu-item ,(purecopy "Construct Regexp") re-builder
-		  :help ,(purecopy "Construct a regexp interactively")))
-    (define-key menu-map [tracing] (cons (purecopy "Tracing") tracing-map))
-    (define-key tracing-map [tr-a]
-      `(menu-item ,(purecopy "Untrace All") untrace-all
-		  :help ,(purecopy "Untrace all currently traced functions")))
-    (define-key tracing-map [tr-uf]
-      `(menu-item ,(purecopy "Untrace Function...") untrace-function
-		  :help ,(purecopy "Untrace function, and possibly activate all remaining advice")))
-    (define-key tracing-map [tr-sep] menu-bar-separator)
-    (define-key tracing-map [tr-q]
-      `(menu-item ,(purecopy "Trace Function Quietly...") trace-function-background
-		  :help ,(purecopy "Trace the function with trace output going quietly to a buffer")))
-    (define-key tracing-map [tr-f]
-      `(menu-item ,(purecopy "Trace Function...") trace-function
-		  :help ,(purecopy "Trace the function given as an argument")))
-    (define-key menu-map [profiling] (cons (purecopy "Profiling") prof-map))
-    (define-key prof-map [prof-restall]
-      `(menu-item ,(purecopy "Remove Instrumentation for All Functions") elp-restore-all
-		  :help ,(purecopy "Restore the original definitions of all functions being profiled")))
-    (define-key prof-map [prof-restfunc]
-      `(menu-item ,(purecopy "Remove Instrumentation for Function...") elp-restore-function
-		  :help ,(purecopy "Restore an instrumented function to its original definition")))
-
-    (define-key prof-map [sep-rem] menu-bar-separator)
-    (define-key prof-map [prof-resall]
-      `(menu-item ,(purecopy "Reset Counters for All Functions") elp-reset-all
-		  :help ,(purecopy "Reset the profiling information for all functions being profiled")))
-    (define-key prof-map [prof-resfunc]
-      `(menu-item ,(purecopy "Reset Counters for Function...") elp-reset-function
-		  :help ,(purecopy "Reset the profiling information for a function")))
-    (define-key prof-map [prof-res]
-      `(menu-item ,(purecopy "Show Profiling Results") elp-results
-		  :help ,(purecopy "Display current profiling results")))
-    (define-key prof-map [prof-pack]
-      `(menu-item ,(purecopy "Instrument Package...") elp-instrument-package
-		  :help ,(purecopy "Instrument for profiling all function that start with a prefix")))
-    (define-key prof-map [prof-func]
-      `(menu-item ,(purecopy "Instrument Function...") elp-instrument-function
-		  :help ,(purecopy "Instrument a function for profiling")))
-    (define-key menu-map [lint] (cons (purecopy "Linting") lint-map))
-    (define-key lint-map [lint-di]
-      `(menu-item ,(purecopy "Lint Directory...") elint-directory
-		  :help ,(purecopy "Lint a directory")))
-    (define-key lint-map [lint-f]
-      `(menu-item ,(purecopy "Lint File...") elint-file
-		  :help ,(purecopy "Lint a file")))
-    (define-key lint-map [lint-b]
-      `(menu-item ,(purecopy "Lint Buffer") elint-current-buffer
-		  :help ,(purecopy "Lint the current buffer")))
-    (define-key lint-map [lint-d]
-      `(menu-item ,(purecopy "Lint Defun") elint-defun
-		  :help ,(purecopy "Lint the function at point")))
-    (define-key menu-map [edebug-defun]
-      `(menu-item ,(purecopy "Instrument Function for Debugging") edebug-defun
-		  :help ,(purecopy "Evaluate the top level form point is in, stepping through with Edebug")
-		  :keys ,(purecopy "C-u C-M-x")))
-    (define-key menu-map [separator-byte] menu-bar-separator)
-    (define-key menu-map [disas]
-      `(menu-item ,(purecopy "Disassemble Byte Compiled Object...") disassemble
-		  :help ,(purecopy "Print disassembled code for OBJECT in a buffer")))
-    (define-key menu-map [byte-recompile]
-      `(menu-item ,(purecopy "Byte-recompile Directory...") byte-recompile-directory
-		  :help ,(purecopy "Recompile every `.el' file in DIRECTORY that needs recompilation")))
-    (define-key menu-map [emacs-byte-compile-and-load]
-      `(menu-item ,(purecopy "Byte-compile and Load") emacs-lisp-byte-compile-and-load
-		  :help ,(purecopy "Byte-compile the current file (if it has changed), then load compiled code")))
-    (define-key menu-map [byte-compile]
-      `(menu-item ,(purecopy "Byte-compile This File") emacs-lisp-byte-compile
-		  :help ,(purecopy "Byte compile the file containing the current buffer")))
-    (define-key menu-map [separator-eval] menu-bar-separator)
-    (define-key menu-map [ielm]
-      `(menu-item ,(purecopy "Interactive Expression Evaluation") ielm
-		  :help ,(purecopy "Interactively evaluate Emacs Lisp expressions")))
-    (define-key menu-map [eval-buffer]
-      `(menu-item ,(purecopy "Evaluate Buffer") eval-buffer
-		  :help ,(purecopy "Execute the current buffer as Lisp code")))
-    (define-key menu-map [eval-region]
-      `(menu-item ,(purecopy "Evaluate Region") eval-region
-		  :help ,(purecopy "Execute the region as Lisp code")
+		  :help "Display the documentation string for the item under cursor"))
+    (bindings--define-key menu-map [checkdoc]
+      '(menu-item "Check Documentation Strings" checkdoc
+		  :help "Check documentation strings for style requirements"))
+    (bindings--define-key menu-map [re-builder]
+      '(menu-item "Construct Regexp" re-builder
+		  :help "Construct a regexp interactively"))
+    (bindings--define-key menu-map [tracing] (cons "Tracing" tracing-map))
+    (bindings--define-key tracing-map [tr-a]
+      '(menu-item "Untrace All" untrace-all
+		  :help "Untrace all currently traced functions"))
+    (bindings--define-key tracing-map [tr-uf]
+      '(menu-item "Untrace Function..." untrace-function
+		  :help "Untrace function, and possibly activate all remaining advice"))
+    (bindings--define-key tracing-map [tr-sep] menu-bar-separator)
+    (bindings--define-key tracing-map [tr-q]
+      '(menu-item "Trace Function Quietly..." trace-function-background
+		  :help "Trace the function with trace output going quietly to a buffer"))
+    (bindings--define-key tracing-map [tr-f]
+      '(menu-item "Trace Function..." trace-function
+		  :help "Trace the function given as an argument"))
+    (bindings--define-key menu-map [profiling] (cons "Profiling" prof-map))
+    (bindings--define-key prof-map [prof-restall]
+      '(menu-item "Remove Instrumentation for All Functions" elp-restore-all
+		  :help "Restore the original definitions of all functions being profiled"))
+    (bindings--define-key prof-map [prof-restfunc]
+      '(menu-item "Remove Instrumentation for Function..." elp-restore-function
+		  :help "Restore an instrumented function to its original definition"))
+
+    (bindings--define-key prof-map [sep-rem] menu-bar-separator)
+    (bindings--define-key prof-map [prof-resall]
+      '(menu-item "Reset Counters for All Functions" elp-reset-all
+		  :help "Reset the profiling information for all functions being profiled"))
+    (bindings--define-key prof-map [prof-resfunc]
+      '(menu-item "Reset Counters for Function..." elp-reset-function
+		  :help "Reset the profiling information for a function"))
+    (bindings--define-key prof-map [prof-res]
+      '(menu-item "Show Profiling Results" elp-results
+		  :help "Display current profiling results"))
+    (bindings--define-key prof-map [prof-pack]
+      '(menu-item "Instrument Package..." elp-instrument-package
+		  :help "Instrument for profiling all function that start with a prefix"))
+    (bindings--define-key prof-map [prof-func]
+      '(menu-item "Instrument Function..." elp-instrument-function
+		  :help "Instrument a function for profiling"))
+    (bindings--define-key menu-map [lint] (cons "Linting" lint-map))
+    (bindings--define-key lint-map [lint-di]
+      '(menu-item "Lint Directory..." elint-directory
+		  :help "Lint a directory"))
+    (bindings--define-key lint-map [lint-f]
+      '(menu-item "Lint File..." elint-file
+		  :help "Lint a file"))
+    (bindings--define-key lint-map [lint-b]
+      '(menu-item "Lint Buffer" elint-current-buffer
+		  :help "Lint the current buffer"))
+    (bindings--define-key lint-map [lint-d]
+      '(menu-item "Lint Defun" elint-defun
+		  :help "Lint the function at point"))
+    (bindings--define-key menu-map [edebug-defun]
+      '(menu-item "Instrument Function for Debugging" edebug-defun
+		  :help "Evaluate the top level form point is in, stepping through with Edebug"
+		  :keys "C-u C-M-x"))
+    (bindings--define-key menu-map [separator-byte] menu-bar-separator)
+    (bindings--define-key menu-map [disas]
+      '(menu-item "Disassemble Byte Compiled Object..." disassemble
+		  :help "Print disassembled code for OBJECT in a buffer"))
+    (bindings--define-key menu-map [byte-recompile]
+      '(menu-item "Byte-recompile Directory..." byte-recompile-directory
+		  :help "Recompile every `.el' file in DIRECTORY that needs recompilation"))
+    (bindings--define-key menu-map [emacs-byte-compile-and-load]
+      '(menu-item "Byte-compile and Load" emacs-lisp-byte-compile-and-load
+		  :help "Byte-compile the current file (if it has changed), then load compiled code"))
+    (bindings--define-key menu-map [byte-compile]
+      '(menu-item "Byte-compile This File" emacs-lisp-byte-compile
+		  :help "Byte compile the file containing the current buffer"))
+    (bindings--define-key menu-map [separator-eval] menu-bar-separator)
+    (bindings--define-key menu-map [ielm]
+      '(menu-item "Interactive Expression Evaluation" ielm
+		  :help "Interactively evaluate Emacs Lisp expressions"))
+    (bindings--define-key menu-map [eval-buffer]
+      '(menu-item "Evaluate Buffer" eval-buffer
+		  :help "Execute the current buffer as Lisp code"))
+    (bindings--define-key menu-map [eval-region]
+      '(menu-item "Evaluate Region" eval-region
+		  :help "Execute the region as Lisp code"
 		  :enable mark-active))
-    (define-key menu-map [eval-sexp]
-      `(menu-item ,(purecopy "Evaluate Last S-expression") eval-last-sexp
-		  :help ,(purecopy "Evaluate sexp before point; print value in minibuffer")))
-    (define-key menu-map [separator-format] menu-bar-separator)
-    (define-key menu-map [comment-region]
-      `(menu-item ,(purecopy "Comment Out Region") comment-region
-		  :help ,(purecopy "Comment or uncomment each line in the region")
+    (bindings--define-key menu-map [eval-sexp]
+      '(menu-item "Evaluate Last S-expression" eval-last-sexp
+		  :help "Evaluate sexp before point; print value in minibuffer"))
+    (bindings--define-key menu-map [separator-format] menu-bar-separator)
+    (bindings--define-key menu-map [comment-region]
+      '(menu-item "Comment Out Region" comment-region
+		  :help "Comment or uncomment each line in the region"
 		  :enable mark-active))
-    (define-key menu-map [indent-region]
-      `(menu-item ,(purecopy "Indent Region") indent-region
-		  :help ,(purecopy "Indent each nonblank line in the region")
+    (bindings--define-key menu-map [indent-region]
+      '(menu-item "Indent Region" indent-region
+		  :help "Indent each nonblank line in the region"
 		  :enable mark-active))
-    (define-key menu-map [indent-line]
-      `(menu-item ,(purecopy "Indent Line") lisp-indent-line))
+    (bindings--define-key menu-map [indent-line]
+      '(menu-item "Indent Line" lisp-indent-line))
     map)
   "Keymap for Emacs Lisp mode.
 All commands in `lisp-mode-shared-map' are inherited by this map.")
@@ -442,22 +431,77 @@ if that value is non-nil."
   (add-hook 'completion-at-point-functions
             'lisp-completion-at-point nil 'local))
 
+;;; Emacs Lisp Byte-Code mode
+
+(eval-and-compile
+  (defconst emacs-list-byte-code-comment-re
+    (concat "\\(#\\)@\\([0-9]+\\) "
+            ;; Make sure it's a docstring and not a lazy-loaded byte-code.
+            "\\(?:[^(]\\|([^\"]\\)")))
+
+(defun emacs-lisp-byte-code-comment (end &optional _point)
+  "Try to syntactically mark the #@NNN ....^_ docstrings in byte-code files."
+  (let ((ppss (syntax-ppss)))
+    (when (and (nth 4 ppss)
+               (eq (char-after (nth 8 ppss)) ?#))
+      (let* ((n (save-excursion
+                  (goto-char (nth 8 ppss))
+                  (when (looking-at emacs-list-byte-code-comment-re)
+                    (string-to-number (match-string 2)))))
+             ;; `maxdiff' tries to make sure the loop below terminates.
+             (maxdiff n))
+        (when n
+          (let* ((bchar (match-end 2))
+                 (b (position-bytes bchar)))
+            (goto-char (+ b n))
+            (while (let ((diff (- (position-bytes (point)) b n)))
+                     (unless (zerop diff)
+                       (when (> diff maxdiff) (setq diff maxdiff))
+                       (forward-char (- diff))
+                       (setq maxdiff (if (> diff 0) diff
+                                       (max (1- maxdiff) 1)))
+                       t))))
+          (if (<= (point) end)
+              (put-text-property (1- (point)) (point)
+                                 'syntax-table
+                                 (string-to-syntax "> b"))
+            (goto-char end)))))))
+
+(defun emacs-lisp-byte-code-syntax-propertize (start end)
+  (emacs-lisp-byte-code-comment end (point))
+  (funcall
+   (syntax-propertize-rules
+    (emacs-list-byte-code-comment-re
+     (1 (prog1 "< b" (emacs-lisp-byte-code-comment end (point))))))
+   start end))
+
+(add-to-list 'auto-mode-alist '("\\.elc\\'" . emacs-lisp-byte-code-mode))
+(define-derived-mode emacs-lisp-byte-code-mode emacs-lisp-mode
+  "Elisp-Byte-Code"
+  "Major mode for *.elc files."
+  ;; TODO: Add way to disassemble byte-code under point.
+  (setq-local open-paren-in-column-0-is-defun-start nil)
+  (setq-local syntax-propertize-function
+              #'emacs-lisp-byte-code-syntax-propertize))
+
+;;; Generic Lisp mode.
+
 (defvar lisp-mode-map
   (let ((map (make-sparse-keymap))
 	(menu-map (make-sparse-keymap "Lisp")))
     (set-keymap-parent map lisp-mode-shared-map)
     (define-key map "\e\C-x" 'lisp-eval-defun)
     (define-key map "\C-c\C-z" 'run-lisp)
-    (define-key map [menu-bar lisp] (cons (purecopy "Lisp") menu-map))
-    (define-key menu-map [run-lisp]
-      `(menu-item ,(purecopy "Run inferior Lisp") run-lisp
-		  :help ,(purecopy "Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'")))
-    (define-key menu-map [ev-def]
-      `(menu-item ,(purecopy "Eval defun") lisp-eval-defun
-		  :help ,(purecopy "Send the current defun to the Lisp process made by M-x run-lisp")))
-    (define-key menu-map [ind-sexp]
-      `(menu-item ,(purecopy "Indent sexp") indent-sexp
-		  :help ,(purecopy "Indent each line of the list starting just after point")))
+    (bindings--define-key map [menu-bar lisp] (cons "Lisp" menu-map))
+    (bindings--define-key menu-map [run-lisp]
+      '(menu-item "Run inferior Lisp" run-lisp
+		  :help "Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'"))
+    (bindings--define-key menu-map [ev-def]
+      '(menu-item "Eval defun" lisp-eval-defun
+		  :help "Send the current defun to the Lisp process made by M-x run-lisp"))
+    (bindings--define-key menu-map [ind-sexp]
+      '(menu-item "Indent sexp" indent-sexp
+		  :help "Indent each line of the list starting just after point"))
     map)
   "Keymap for ordinary Lisp mode.
 All commands in `lisp-mode-shared-map' are inherited by this map.")
@@ -505,23 +549,24 @@ if that value is non-nil."
     (define-key map "\e\C-q" 'indent-pp-sexp)
     (define-key map "\e\t" 'completion-at-point)
     (define-key map "\n" 'eval-print-last-sexp)
-    (define-key map [menu-bar lisp-interaction] (cons (purecopy "Lisp-Interaction") menu-map))
-    (define-key menu-map [eval-defun]
-      `(menu-item ,(purecopy "Evaluate Defun") eval-defun
-		  :help ,(purecopy "Evaluate the top-level form containing point, or after point")))
-    (define-key menu-map [eval-print-last-sexp]
-      `(menu-item ,(purecopy "Evaluate and Print") eval-print-last-sexp
-		  :help ,(purecopy "Evaluate sexp before point; print value into current buffer")))
-    (define-key menu-map [edebug-defun-lisp-interaction]
-      `(menu-item ,(purecopy "Instrument Function for Debugging") edebug-defun
-		  :help ,(purecopy "Evaluate the top level form point is in, stepping through with Edebug")
-		  :keys ,(purecopy "C-u C-M-x")))
-    (define-key menu-map [indent-pp-sexp]
-      `(menu-item ,(purecopy "Indent or Pretty-Print") indent-pp-sexp
-		  :help ,(purecopy "Indent each line of the list starting just after point, or prettyprint it")))
-    (define-key menu-map [complete-symbol]
-      `(menu-item ,(purecopy "Complete Lisp Symbol") completion-at-point
-		  :help ,(purecopy "Perform completion on Lisp symbol preceding point")))
+    (bindings--define-key map [menu-bar lisp-interaction]
+      (cons "Lisp-Interaction" menu-map))
+    (bindings--define-key menu-map [eval-defun]
+      '(menu-item "Evaluate Defun" eval-defun
+		  :help "Evaluate the top-level form containing point, or after point"))
+    (bindings--define-key menu-map [eval-print-last-sexp]
+      '(menu-item "Evaluate and Print" eval-print-last-sexp
+		  :help "Evaluate sexp before point; print value into current buffer"))
+    (bindings--define-key menu-map [edebug-defun-lisp-interaction]
+      '(menu-item "Instrument Function for Debugging" edebug-defun
+		  :help "Evaluate the top level form point is in, stepping through with Edebug"
+		  :keys "C-u C-M-x"))
+    (bindings--define-key menu-map [indent-pp-sexp]
+      '(menu-item "Indent or Pretty-Print" indent-pp-sexp
+		  :help "Indent each line of the list starting just after point, or prettyprint it"))
+    (bindings--define-key menu-map [complete-symbol]
+      '(menu-item "Complete Lisp Symbol" completion-at-point
+		  :help "Perform completion on Lisp symbol preceding point"))
     map)
   "Keymap for Lisp Interaction mode.
 All commands in `lisp-mode-shared-map' are inherited by this map.")
@@ -540,7 +585,8 @@ 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.")
+if that value is non-nil."
+  :abbrev-table nil)
 
 (defun eval-print-last-sexp ()
   "Evaluate sexp before point; print value into current buffer.
@@ -739,10 +785,12 @@ POS specifies the starting position where EXP was found and defaults to point."
       (let ((vars ()))
         (goto-char (point-min))
         (while (re-search-forward
-                "^(def\\(?:var\\|const\\|custom\\)[ \t\n]+\\([^; '()\n\t]+\\)"
+                "(def\\(?:var\\|const\\|custom\\)[ \t\n]+\\([^; '()\n\t]+\\)"
                 pos t)
           (let ((var (intern (match-string 1))))
-            (unless (special-variable-p var)
+            (and (not (special-variable-p var))
+                 (save-excursion
+                   (zerop (car (syntax-ppss (match-beginning 0)))))
               (push var vars))))
         `(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp)))))
 
@@ -785,7 +833,12 @@ Reinitialize the face according to the `defface' specification."
 	      (default-boundp (eval (nth 1 form) lexical-binding)))
 	 ;; Force variable to be bound.
 	 (set-default (eval (nth 1 form) lexical-binding)
-                      (eval (nth 1 (nth 2 form)) lexical-binding))
+		      ;; The second arg is an expression that evaluates to
+		      ;; an expression.  The second evaluation is the one
+		      ;; normally performed not be normal execution but by
+		      ;; custom-initialize-set (for example), which does not
+		      ;; use lexical-binding.
+		      (eval (eval (nth 2 form) lexical-binding)))
 	 form)
 	;; `defface' is macroexpanded to `custom-declare-face'.
 	((eq (car form) 'custom-declare-face)
@@ -824,7 +877,6 @@ if it already has a value.\)
 
 With argument, insert value in current buffer after the defun.
 Return the result of evaluation."
-  (interactive "P")
   ;; FIXME: the print-length/level bindings should only be applied while
   ;; printing, not while evaluating.
   (let ((debug-on-error eval-expression-debug-on-error)
@@ -844,10 +896,10 @@ Return the result of evaluation."
 	   (end-of-defun)
 	   (beginning-of-defun)
 	   (setq beg (point))
-	   (setq form (eval-sexp-add-defvars (read (current-buffer))))
+	   (setq form (read (current-buffer)))
 	   (setq end (point)))
 	 ;; Alter the form if necessary.
-	 (setq form (eval-defun-1 (macroexpand form)))
+	 (setq form (eval-sexp-add-defvars (eval-defun-1 (macroexpand form))))
 	 (list beg end standard-output
 	       `(lambda (ignore)
 		 ;; Skipping to the end of the specified region
@@ -929,6 +981,7 @@ rigidly along with this one."
     (if (or (null indent) (looking-at "\\s<\\s<\\s<"))
 	;; Don't alter indentation of a ;;; comment line
 	;; or a line that starts in a string.
+        ;; FIXME: inconsistency: comment-indent moves ;;; to column 0.
 	(goto-char (- (point-max) pos))
       (if (and (looking-at "\\s<") (not (looking-at "\\s<\\s<")))
 	  ;; Single-semicolon comment lines should be indented
@@ -943,18 +996,7 @@ rigidly along with this one."
       ;; 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)))))
+	  (goto-char (- (point-max) pos))))))
 
 (defvar calculate-lisp-indent-last-sexp)
 
@@ -1150,7 +1192,8 @@ Lisp function does not specify a special indentation."
       (let ((function (buffer-substring (point)
 					(progn (forward-sexp 1) (point))))
 	    method)
-	(setq method (or (get (intern-soft function) 'lisp-indent-function)
+	(setq method (or (function-get (intern-soft function)
+                                       'lisp-indent-function)
 			 (get (intern-soft function) 'lisp-indent-hook)))
 	(cond ((or (eq method 'defun)
 		   (and (null method)
@@ -1227,14 +1270,12 @@ Lisp function does not specify a special indentation."
 ;; 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-restriction 'lisp-indent-function 0)
-(put 'save-match-data 'lisp-indent-function 0)
 (put 'save-current-buffer 'lisp-indent-function 0)
 (put 'let 'lisp-indent-function 1)
 (put 'let* 'lisp-indent-function 1)
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index db6a03333d4..bcb7fab026b 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -1,6 +1,6 @@
 ;;; lisp.el --- Lisp editing commands for Emacs
 
-;; Copyright (C) 1985-1986, 1994, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1986, 1994, 2000-2012 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: lisp, languages
@@ -257,9 +257,8 @@ is called as a function to find the defun's beginning."
        (if (> arg 0)
            (dotimes (i arg)
              (funcall beginning-of-defun-function))
-         ;; Better not call end-of-defun-function directly, in case
-         ;; it's not defined.
-         (end-of-defun (- arg))))))
+	 (dotimes (i (- arg))
+	   (funcall end-of-defun-function))))))
 
    ((or defun-prompt-regexp open-paren-in-column-0-is-defun-start)
     (and (< arg 0) (not (eobp)) (forward-char 1))
@@ -448,7 +447,21 @@ Optional ARG is ignored."
       ;; Try first in this order for the sake of languages with nested
       ;; functions where several can end at the same place as with
       ;; the offside rule, e.g. Python.
-      (beginning-of-defun)
+
+      ;; Finding the start of the function is a bit problematic since
+      ;; `beginning-of-defun' when we are on the first character of
+      ;; the function might go to the previous function.
+      ;;
+      ;; Therefore we first move one character forward and then call
+      ;; `beginning-of-defun'.  However now we must check that we did
+      ;; not move into the next function.
+      (let ((here (point)))
+        (unless (eolp)
+	  (forward-char))
+        (beginning-of-defun)
+        (when (< (point) here)
+          (goto-char here)
+          (beginning-of-defun)))
       (setq beg (point))
       (end-of-defun)
       (setq end (point))
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index ccfdf2e0551..2a3730745c6 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -1,6 +1,6 @@
-;;; macroexp.el --- Additional macro-expansion support -*- lexical-binding: t -*-
+;;; macroexp.el --- Additional macro-expansion support -*- lexical-binding: t; coding: utf-8 -*-
 ;;
-;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
 ;;
 ;; Author: Miles Bader <miles@gnu.org>
 ;; Keywords: lisp, compiler, macros
@@ -29,13 +29,11 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'cl))
-
 ;; Bound by the top-level `macroexpand-all', and modified to include any
 ;; macros defined by `defmacro'.
 (defvar macroexpand-all-environment nil)
 
-(defun maybe-cons (car cdr original-cons)
+(defun macroexp--cons (car cdr original-cons)
   "Return (CAR . CDR), using ORIGINAL-CONS if possible."
   (if (and (eq car (car original-cons)) (eq cdr (cdr original-cons)))
       original-cons
@@ -43,9 +41,9 @@
 
 ;; We use this special macro to iteratively process forms and share list
 ;; structure of the result with the input.  Doing so recursively using
-;; `maybe-cons' results in excessively deep recursion for very long
+;; `macroexp--cons' results in excessively deep recursion for very long
 ;; input forms.
-(defmacro macroexp-accumulate (var+list &rest body)
+(defmacro macroexp--accumulate (var+list &rest body)
   "Return a list of the results of evaluating BODY for each element of LIST.
 Evaluate BODY with VAR bound to each `car' from LIST, in turn.
 Return a list of the values of the final form in BODY.
@@ -65,7 +63,7 @@ result will be eq to LIST).
 	    (,unshared nil)
 	    (,tail ,shared)
 	    ,var ,new-el)
-       (while ,tail
+       (while (consp ,tail)
 	 (setq ,var (car ,tail)
 	       ,new-el (progn ,@body))
 	 (unless (eq ,var ,new-el)
@@ -76,27 +74,69 @@ result will be eq to LIST).
 	 (setq ,tail (cdr ,tail)))
        (nconc (nreverse ,unshared) ,shared))))
 
-(defun macroexpand-all-forms (forms &optional skip)
+(defun macroexp--all-forms (forms &optional skip)
   "Return FORMS with macros expanded.  FORMS is a list of forms.
 If SKIP is non-nil, then don't expand that many elements at the start of
 FORMS."
-  (macroexp-accumulate (form forms)
+  (macroexp--accumulate (form forms)
     (if (or (null skip) (zerop skip))
-	(macroexpand-all-1 form)
+	(macroexp--expand-all form)
       (setq skip (1- skip))
       form)))
 
-(defun macroexpand-all-clauses (clauses &optional skip)
+(defun macroexp--all-clauses (clauses &optional skip)
   "Return CLAUSES with macros expanded.
 CLAUSES is a list of lists of forms; any clause that's not a list is ignored.
 If SKIP is non-nil, then don't expand that many elements at the start of
 each clause."
-  (macroexp-accumulate (clause clauses)
+  (macroexp--accumulate (clause clauses)
     (if (listp clause)
-	(macroexpand-all-forms clause skip)
+	(macroexp--all-forms clause skip)
       clause)))
 
-(defun macroexpand-all-1 (form)
+(defun macroexp--compiler-macro (handler form)
+  (condition-case err
+      (apply handler form (cdr form))
+    (error (message "Compiler-macro error for %S: %S" (car form) err)
+           form)))
+
+(defun macroexp--funcall-if-compiled (_form)
+  "Pseudo function used internally by macroexp to delay warnings.
+The purpose is to delay warnings to bytecomp.el, so they can use things
+like `byte-compile-log-warning' to get better file-and-line-number data
+and also to avoid outputting the warning during normal execution."
+  nil)
+(put 'macroexp--funcall-if-compiled 'byte-compile
+     (lambda (form)
+       (funcall (eval (cadr form)))
+       (byte-compile-constant nil)))
+
+(defun macroexp--warn-and-return (msg form)
+  (let ((when-compiled (lambda () (byte-compile-log-warning msg t))))
+    (cond
+     ((null msg) form)
+     ;; FIXME: ¡¡Major Ugly Hack!! To determine whether the output of this
+     ;; macro-expansion will be processed by the byte-compiler, we check
+     ;; circumstantial evidence.
+     ((member '(declare-function . byte-compile-macroexpand-declare-function)
+                macroexpand-all-environment)
+      `(progn
+         (macroexp--funcall-if-compiled ',when-compiled)
+         ,form))
+     (t
+      (message "%s" msg)
+      form))))
+
+(defun macroexp--obsolete-warning (fun obsolescence-data type)
+  (let ((instead (car obsolescence-data))
+        (asof (nth 2 obsolescence-data)))
+    (format "`%s' is an obsolete %s%s%s" fun type
+            (if asof (concat " (as of " asof ")") "")
+            (cond ((stringp instead) (concat "; " instead))
+                  (instead (format "; use `%s' instead." instead))
+                  (t ".")))))
+
+(defun macroexp--expand-all (form)
   "Expand all macros in FORM.
 This is an internal version of `macroexpand-all'.
 Assumes the caller has bound `macroexpand-all-environment'."
@@ -105,61 +145,57 @@ Assumes the caller has bound `macroexpand-all-environment'."
       ;; generates exceedingly deep expansions from relatively shallow input
       ;; forms.  We just process it `in reverse' -- first we expand all the
       ;; arguments, _then_ we expand the top-level definition.
-      (macroexpand (macroexpand-all-forms form 1)
+      (macroexpand (macroexp--all-forms form 1)
 		   macroexpand-all-environment)
     ;; Normal form; get its expansion, and then expand arguments.
-    (let ((new-form (macroexpand form macroexpand-all-environment)))
-      (when (and (not (eq form new-form)) ;It was a macro call.
-                 (car-safe form)
-                 (symbolp (car form))
-                 (get (car form) 'byte-obsolete-info)
-                 (fboundp 'byte-compile-warn-obsolete))
-        (byte-compile-warn-obsolete (car form)))
-      (setq form new-form))
+    (let ((new-form
+           (macroexpand form macroexpand-all-environment)))
+      (setq form
+            (if (and (not (eq form new-form)) ;It was a macro call.
+                     (car-safe form)
+                     (symbolp (car form))
+                     (get (car form) 'byte-obsolete-info)
+                     (or (not (fboundp 'byte-compile-warning-enabled-p))
+                         (byte-compile-warning-enabled-p 'obsolete)))
+                (let* ((fun (car form))
+                       (obsolete (get fun 'byte-obsolete-info)))
+                  (macroexp--warn-and-return
+                   (macroexp--obsolete-warning
+                    fun obsolete
+                    (if (symbolp (symbol-function fun))
+                        "alias" "macro"))
+                   new-form))
+              new-form)))
     (pcase form
       (`(cond . ,clauses)
-       (maybe-cons 'cond (macroexpand-all-clauses clauses) form))
+       (macroexp--cons 'cond (macroexp--all-clauses clauses) form))
       (`(condition-case . ,(or `(,err ,body . ,handlers) dontcare))
-       (maybe-cons
+       (macroexp--cons
         'condition-case
-        (maybe-cons err
-                    (maybe-cons (macroexpand-all-1 body)
-                                (macroexpand-all-clauses handlers 1)
+        (macroexp--cons err
+                    (macroexp--cons (macroexp--expand-all body)
+                                (macroexp--all-clauses handlers 1)
                                 (cddr form))
                     (cdr form))
         form))
-      (`(defmacro ,name . ,args-and-body)
-       (push (cons name (cons 'lambda args-and-body))
-             macroexpand-all-environment)
-       (let ((n 3))
-         ;; Don't macroexpand `declare' since it should really be "expanded"
-         ;; away when `defmacro' is expanded, but currently defmacro is not
-         ;; itself a macro.  So both `defmacro' and `declare' need to be
-         ;; handled directly in bytecomp.el.
-         ;; FIXME: Maybe a simpler solution is to (defalias 'declare 'quote).
-         (while (or (stringp (nth n form))
-                    (eq (car-safe (nth n form)) 'declare))
-           (setq n (1+ n)))
-         (macroexpand-all-forms form n)))
-      (`(defun . ,_) (macroexpand-all-forms form 3))
-      (`(,(or `defvar `defconst) . ,_) (macroexpand-all-forms form 2))
+      (`(,(or `defvar `defconst) . ,_) (macroexp--all-forms form 2))
       (`(function ,(and f `(lambda . ,_)))
-       (maybe-cons 'function
-                   (maybe-cons (macroexpand-all-forms f 2)
+       (macroexp--cons 'function
+                   (macroexp--cons (macroexp--all-forms f 2)
                                nil
                                (cdr form))
                    form))
       (`(,(or `function `quote) . ,_) form)
       (`(,(and fun (or `let `let*)) . ,(or `(,bindings . ,body) dontcare))
-       (maybe-cons fun
-                   (maybe-cons (macroexpand-all-clauses bindings 1)
-                               (macroexpand-all-forms body)
+       (macroexp--cons fun
+                   (macroexp--cons (macroexp--all-clauses bindings 1)
+                               (macroexp--all-forms body)
                                (cdr form))
                    form))
       (`(,(and fun `(lambda . ,_)) . ,args)
        ;; Embedded lambda in function position.
-       (maybe-cons (macroexpand-all-forms fun 2)
-                   (macroexpand-all-forms args)
+       (macroexp--cons (macroexp--all-forms fun 2)
+                   (macroexp--all-forms args)
                    form))
       ;; The following few cases are for normal function calls that
       ;; are known to funcall one of their arguments.  The byte
@@ -171,45 +207,44 @@ Assumes the caller has bound `macroexpand-all-environment'."
       ;; First arg is a function:
       (`(,(and fun (or `funcall `apply `mapcar `mapatoms `mapconcat `mapc))
          ',(and f `(lambda . ,_)) . ,args)
-       (byte-compile-log-warning
+       (macroexp--warn-and-return
         (format "%s quoted with ' rather than with #'"
                 (list 'lambda (nth 1 f) '...))
-        t)
-       ;; We don't use `maybe-cons' since there's clearly a change.
-       (cons fun
-             (cons (macroexpand-all-1 (list 'function f))
-                   (macroexpand-all-forms args))))
+        (macroexp--expand-all `(,fun ,f . ,args))))
       ;; Second arg is a function:
       (`(,(and fun (or `sort)) ,arg1 ',(and f `(lambda . ,_)) . ,args)
-       (byte-compile-log-warning
+       (macroexp--warn-and-return
         (format "%s quoted with ' rather than with #'"
                 (list 'lambda (nth 1 f) '...))
-        t)
-       ;; We don't use `maybe-cons' since there's clearly a change.
-       (cons fun
-             (cons (macroexpand-all-1 arg1)
-                   (cons (macroexpand-all-1
-                          (list 'function f))
-                         (macroexpand-all-forms args)))))
-      ;; Macro expand compiler macros.  This cannot be delayed to
-      ;; byte-optimize-form because the output of the compiler-macro can
-      ;; use macros.
-      ;; FIXME: Don't depend on CL.
-      (`(,(pred (lambda (fun)
-                  (and (symbolp fun)
-                       (eq (get fun 'byte-compile)
-                           'cl-byte-compile-compiler-macro)
-                       (functionp 'compiler-macroexpand))))
-         . ,_)
-       (let ((newform (with-no-warnings (compiler-macroexpand form))))
-         (if (eq form newform)
-             (macroexpand-all-forms form 1)
-           (macroexpand-all-1 newform))))
-      (`(,_ . ,_)
-       ;; For every other list, we just expand each argument (for
-       ;; setq/setq-default this works alright because the variable names
-       ;; are symbols).
-       (macroexpand-all-forms form 1))
+        (macroexp--expand-all `(,fun ,arg1 ,f . ,args))))
+      (`(,func . ,_)
+       ;; Macro expand compiler macros.  This cannot be delayed to
+       ;; byte-optimize-form because the output of the compiler-macro can
+       ;; use macros.
+       (let ((handler (function-get func 'compiler-macro)))
+         (if (null handler)
+             ;; No compiler macro.  We just expand each argument (for
+             ;; setq/setq-default this works alright because the variable names
+             ;; are symbols).
+             (macroexp--all-forms form 1)
+           ;; If the handler is not loaded yet, try (auto)loading the
+           ;; function itself, which may in turn load the handler.
+           (unless (functionp handler)
+             (ignore-errors
+               (autoload-do-load (indirect-function func) func)))
+           (let ((newform (macroexp--compiler-macro handler form)))
+             (if (eq form newform)
+                 ;; The compiler macro did not find anything to do.
+                 (if (equal form (setq newform (macroexp--all-forms form 1)))
+                     form
+                   ;; Maybe after processing the args, some new opportunities
+                   ;; appeared, so let's try the compiler macro again.
+                   (setq form (macroexp--compiler-macro handler newform))
+                   (if (eq newform form)
+                       newform
+                     (macroexp--expand-all newform)))
+               (macroexp--expand-all newform))))))
+
       (t form))))
 
 ;;;###autoload
@@ -219,7 +254,190 @@ If no macros are expanded, FORM is returned unchanged.
 The second optional arg ENVIRONMENT specifies an environment of macro
 definitions to shadow the loaded ones for use in file byte-compilation."
   (let ((macroexpand-all-environment environment))
-    (macroexpand-all-1 form)))
+    (macroexp--expand-all form)))
+
+;;; Handy functions to use in macros.
+
+(defun macroexp-progn (exps)
+  "Return an expression equivalent to `(progn ,@EXPS)."
+  (if (cdr exps) `(progn ,@exps) (car exps)))
+
+(defun macroexp-unprogn (exp)
+  "Turn EXP into a list of expressions to execute in sequence."
+  (if (eq (car-safe exp) 'progn) (cdr exp) (list exp)))
+
+(defun macroexp-let* (bindings exp)
+  "Return an expression equivalent to `(let* ,bindings ,exp)."
+  (cond
+   ((null bindings) exp)
+   ((eq 'let* (car-safe exp)) `(let* (,@bindings ,@(cadr exp)) ,@(cddr exp)))
+   (t `(let* ,bindings ,exp))))
+
+(defun macroexp-if (test then else)
+  "Return an expression equivalent to `(if ,test ,then ,else)."
+  (cond
+   ((eq (car-safe else) 'if)
+    (if (equal test (nth 1 else))
+        ;; Doing a test a second time: get rid of the redundancy.
+        `(if ,test ,then ,@(nthcdr 3 else))
+      `(cond (,test ,then)
+             (,(nth 1 else) ,(nth 2 else))
+             (t ,@(nthcdr 3 else)))))
+   ((eq (car-safe else) 'cond)
+    `(cond (,test ,then)
+           ;; Doing a test a second time: get rid of the redundancy, as above.
+           ,@(remove (assoc test else) (cdr else))))
+   ;; Invert the test if that lets us reduce the depth of the tree.
+   ((memq (car-safe then) '(if cond)) (macroexp-if `(not ,test) else then))
+   (t `(if ,test ,then ,else))))
+
+(defmacro macroexp-let2 (test var exp &rest exps)
+  "Bind VAR to a copyable expression that returns the value of EXP.
+This is like `(let ((v ,EXP)) ,EXPS) except that `v' is a new generated
+symbol which EXPS can find in VAR.
+TEST should be the name of a predicate on EXP checking whether the `let' can
+be skipped; if nil, as is usual, `macroexp-const-p' is used."
+  (declare (indent 3) (debug (sexp sexp form body)))
+  (let ((bodysym (make-symbol "body"))
+        (expsym (make-symbol "exp")))
+    `(let* ((,expsym ,exp)
+            (,var (if (funcall #',(or test #'macroexp-const-p) ,expsym)
+                      ,expsym (make-symbol ,(symbol-name var))))
+            (,bodysym ,(macroexp-progn exps)))
+       (if (eq ,var ,expsym) ,bodysym
+         (macroexp-let* (list (list ,var ,expsym))
+                        ,bodysym)))))
+
+(defun macroexp--maxsize (exp size)
+  (cond ((< size 0) size)
+        ((symbolp exp) (1- size))
+        ((stringp exp) (- size (/ (length exp) 16)))
+        ((vectorp exp)
+         (dotimes (i (length exp))
+           (setq size (macroexp--maxsize (aref exp i) size)))
+         (1- size))
+        ((consp exp)
+         ;; We could try to be more clever with quote&function,
+         ;; but it is difficult to do so correctly, and it's not obvious that
+         ;; it would be worth the effort.
+         (dolist (e exp)
+           (setq size (macroexp--maxsize e size)))
+         (1- size))
+        (t -1)))
+
+(defun macroexp-small-p (exp)
+  "Return non-nil if EXP can be considered small."
+  (> (macroexp--maxsize exp 10) 0))
+
+(defsubst macroexp--const-symbol-p (symbol &optional any-value)
+  "Non-nil if SYMBOL is constant.
+If ANY-VALUE is nil, only return non-nil if the value of the symbol is the
+symbol itself."
+  (or (memq symbol '(nil t))
+      (keywordp symbol)
+      (if any-value
+	  (or (memq symbol byte-compile-const-variables)
+	      ;; FIXME: We should provide a less intrusive way to find out
+	      ;; if a variable is "constant".
+	      (and (boundp symbol)
+		   (condition-case nil
+		       (progn (set symbol (symbol-value symbol)) nil)
+		     (setting-constant t)))))))
+
+(defun macroexp-const-p (exp)
+  "Return non-nil if EXP will always evaluate to the same value."
+  (cond ((consp exp) (or (eq (car exp) 'quote)
+                         (and (eq (car exp) 'function)
+                              (symbolp (cadr exp)))))
+        ;; It would sometimes make sense to pass `any-value', but it's not
+        ;; always safe since a "constant" variable may not actually always have
+        ;; the same value.
+        ((symbolp exp) (macroexp--const-symbol-p exp))
+        (t t)))
+
+(defun macroexp-copyable-p (exp)
+  "Return non-nil if EXP can be copied without extra cost."
+  (or (symbolp exp) (macroexp-const-p exp)))
+
+;;; Load-time macro-expansion.
+
+;; Because macro-expansion used to be more lazy, eager macro-expansion
+;; tends to bump into previously harmless/unnoticeable cyclic-dependencies.
+;; So, we have to delay macro-expansion like we used to when we detect
+;; such a cycle, and we also want to help coders resolve those cycles (since
+;; they can be non-obvious) by providing a usefully trimmed backtrace
+;; (hopefully) highlighting the problem.
+
+(defun macroexp--backtrace ()
+  "Return the Elisp backtrace, more recent frames first."
+  (let ((bt ())
+        (i 0))
+    (while
+        (let ((frame (backtrace-frame i)))
+          (when frame
+            (push frame bt)
+            (setq i (1+ i)))))
+    (nreverse bt)))
+
+(defun macroexp--trim-backtrace-frame (frame)
+  (pcase frame
+    (`(,_ macroexpand (,head . ,_) . ,_) `(macroexpand (,head …)))
+    (`(,_ internal-macroexpand-for-load (,head ,second . ,_) . ,_)
+     (if (or (symbolp second)
+             (and (eq 'quote (car-safe second))
+                  (symbolp (cadr second))))
+         `(macroexpand-all (,head ,second …))
+       '(macroexpand-all …)))
+    (`(,_ load-with-code-conversion ,name . ,_)
+     `(load ,(file-name-nondirectory name)))))
+
+(defvar macroexp--pending-eager-loads nil
+  "Stack of files currently undergoing eager macro-expansion.")
+
+(defun internal-macroexpand-for-load (form)
+  ;; Called from the eager-macroexpansion in readevalloop.
+  (cond
+   ;; Don't repeat the same warning for every top-level element.
+   ((eq 'skip (car macroexp--pending-eager-loads)) form)
+   ;; If we detect a cycle, skip macro-expansion for now, and output a warning
+   ;; with a trimmed backtrace.
+   ((and load-file-name (member load-file-name macroexp--pending-eager-loads))
+    (let* ((bt (delq nil
+                     (mapcar #'macroexp--trim-backtrace-frame
+                             (macroexp--backtrace))))
+           (elem `(load ,(file-name-nondirectory load-file-name)))
+           (tail (member elem (cdr (member elem bt)))))
+      (if tail (setcdr tail (list '…)))
+      (if (eq (car-safe (car bt)) 'macroexpand-all) (setq bt (cdr bt)))
+      (message "Warning: Eager macro-expansion skipped due to cycle:\n  %s"
+               (mapconcat #'prin1-to-string (nreverse bt) " => "))
+      (push 'skip macroexp--pending-eager-loads)
+      form))
+   (t
+    (condition-case err
+        (let ((macroexp--pending-eager-loads
+               (cons load-file-name macroexp--pending-eager-loads)))
+          (macroexpand-all form))
+      (error
+       ;; Hopefully this shouldn't happen thanks to the cycle detection,
+       ;; but in case it does happen, let's catch the error and give the
+       ;; code a chance to macro-expand later.
+       (message "Eager macro-expansion failure: %S" err)
+       form)))))
+
+;; ¡¡¡ Big Ugly Hack !!!
+;; src/bootstrap-emacs is mostly used to compile .el files, so it needs
+;; macroexp, bytecomp, cconv, and byte-opt to be fast.  Generally this is done
+;; by compiling those files first, but this only makes a difference if those
+;; files are not preloaded.  But macroexp.el is preloaded so we reload it if
+;; the current version is interpreted and there's a compiled version available.
+(eval-when-compile
+  (add-hook 'emacs-startup-hook
+            (lambda ()
+              (and (not (byte-code-function-p
+                         (symbol-function 'macroexpand-all)))
+                   (locate-library "macroexp.elc")
+                   (load "macroexp.elc")))))
 
 (provide 'macroexp)
 
diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el
index 6ef26fef89c..289751f4944 100644
--- a/lisp/emacs-lisp/map-ynp.el
+++ b/lisp/emacs-lisp/map-ynp.el
@@ -1,10 +1,11 @@
 ;;; map-ynp.el --- general-purpose boolean question-asker
 
-;; Copyright (C) 1991-1995, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1991-1995, 2000-2012 Free Software Foundation, Inc.
 
 ;; Author: Roland McGrath <roland@gnu.org>
 ;; Maintainer: FSF
 ;; Keywords: lisp, extensions
+;; Package: emacs
 
 ;; This file is part of GNU Emacs.
 
@@ -122,16 +123,6 @@ Returns the number of actions taken."
 	    map
             (let ((map (make-sparse-keymap)))
               (set-keymap-parent map query-replace-map)
-              (define-key map [?\C-\M-v] 'scroll-other-window)
-              (define-key map [M-next] 'scroll-other-window)
-              (define-key map [?\C-\M-\S-v] 'scroll-other-window-down)
-              (define-key map [M-prior] 'scroll-other-window-down)
-              ;; The above are rather inconvenient, so maybe we should
-              ;; provide the non-other keys for the other-scroll as well.
-              ;; (define-key map [?\C-v] 'scroll-other-window)
-              ;; (define-key map [next] 'scroll-other-window)
-              ;; (define-key map [?\M-v] 'scroll-other-window-down)
-              ;; (define-key map [prior] 'scroll-other-window-down)
               (dolist (elt action-alist)
                 (define-key map (vector (car elt)) (vector (nth 1 elt))))
               map)))
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
new file mode 100644
index 00000000000..d9c5316b1b8
--- /dev/null
+++ b/lisp/emacs-lisp/nadvice.el
@@ -0,0 +1,457 @@
+;;; nadvice.el --- Light-weight advice primitives for Elisp functions  -*- lexical-binding: t -*-
+
+;; Copyright (C) 2012  Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+;; Keywords: extensions, lisp, tools
+;; Package: emacs
+
+;; 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 3 of the License, 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, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package lets you add behavior (which we call "piece of advice") to
+;; existing functions, like the old `advice.el' package, but with much fewer
+;; bells ans whistles.  It comes in 2 parts:
+;;
+;; - The first part lets you add/remove functions, similarly to
+;;   add/remove-hook, from any "place" (i.e. as accepted by `setf') that
+;;   holds a function.
+;;   This part provides mainly 2 macros: `add-function' and `remove-function'.
+;;
+;; - The second part provides `advice-add' and `advice-remove' which are
+;;   refined version of the previous macros specially tailored for the case
+;;   where the place that we want to modify is a `symbol-function'.
+
+;;; Code:
+
+;;;; Lightweight advice/hook
+(defvar advice--where-alist
+  '((:around "\300\301\302\003#\207" 5)
+    (:before "\300\301\002\"\210\300\302\002\"\207" 4)
+    (:after "\300\302\002\"\300\301\003\"\210\207" 5)
+    (:after-until "\300\302\002\"\206\013\000\300\301\002\"\207" 4)
+    (:after-while "\300\302\002\"\205\013\000\300\301\002\"\207" 4)
+    (:before-until "\300\301\002\"\206\013\000\300\302\002\"\207" 4)
+    (:before-while "\300\301\002\"\205\013\000\300\302\002\"\207" 4))
+  "List of descriptions of how to add a function.
+Each element has the form (WHERE BYTECODE STACK) where:
+  WHERE is a keyword indicating where the function is added.
+  BYTECODE is the corresponding byte-code that will be used.
+  STACK is the amount of stack space needed by the byte-code.")
+
+(defvar advice--bytecodes (mapcar #'cadr advice--where-alist))
+
+(defun advice--p (object)
+  (and (byte-code-function-p object)
+       (eq 128 (aref object 0))
+       (memq (length object) '(5 6))
+       (memq (aref object 1) advice--bytecodes)
+       (eq #'apply (aref (aref object 2) 0))))
+
+(defsubst advice--car   (f) (aref (aref f 2) 1))
+(defsubst advice--cdr   (f) (aref (aref f 2) 2))
+(defsubst advice--props (f) (aref (aref f 2) 3))
+
+(defun advice--make-docstring (_string function)
+  "Build the raw doc-string of SYMBOL, presumably advised."
+  (let ((flist (indirect-function function))
+        (docstring nil))
+    (if (eq 'macro (car-safe flist)) (setq flist (cdr flist)))
+    (while (advice--p flist)
+      (let ((bytecode (aref flist 1))
+            (where nil))
+        (dolist (elem advice--where-alist)
+          (if (eq bytecode (cadr elem)) (setq where (car elem))))
+        (setq docstring
+              (concat
+               docstring
+               (propertize (format "%s advice: " where)
+                           'face 'warning)
+               (let ((fun (advice--car flist)))
+                 (if (symbolp fun) (format "`%S'" fun)
+                   (let* ((name (cdr (assq 'name (advice--props flist))))
+                          (doc (documentation fun t))
+                          (usage (help-split-fundoc doc function)))
+                     (if usage (setq doc (cdr usage)))
+                     (if name
+                         (if doc
+                             (format "%s\n%s" name doc)
+                           (format "%s" name))
+                       (or doc "No documentation")))))
+               "\n")))
+      (setq flist (advice--cdr flist)))
+    (if docstring (setq docstring (concat docstring "\n")))
+    (let* ((origdoc (unless (eq function flist) ;Avoid inf-loops.
+                      (documentation flist t)))
+           (usage (help-split-fundoc origdoc function)))
+      (setq usage (if (null usage)
+                      (let ((arglist (help-function-arglist flist)))
+                        (format "%S" (help-make-usage function arglist)))
+                    (setq origdoc (cdr usage)) (car usage)))
+      (help-add-fundoc-usage (concat docstring origdoc) usage))))
+
+(defvar advice--docstring
+  ;; Can't eval-when-compile nor use defconst because it then gets pure-copied,
+  ;; which drops the text-properties.
+  ;;(eval-when-compile
+  (propertize "Advised function"
+              'dynamic-docstring-function #'advice--make-docstring)) ;; )
+
+(defun advice-eval-interactive-spec (spec)
+  "Evaluate the interactive spec SPEC."
+  (cond
+   ((stringp spec)
+    ;; There's no direct access to the C code (in call-interactively) that
+    ;; processes those specs, but that shouldn't stop us, should it?
+    ;; FIXME: Despite appearances, this is not faithful: SPEC and
+    ;; (advice-eval-interactive-spec SPEC) will behave subtly differently w.r.t
+    ;; command-history (and maybe a few other details).
+    (call-interactively `(lambda (&rest args) (interactive ,spec) args)))
+   ;; ((functionp spec) (funcall spec))
+   (t (eval spec))))
+
+(defun advice--make-interactive-form (function main)
+  ;; TODO: make it so that interactive spec can be a constant which
+  ;; dynamically checks the advice--car/cdr to do its job.
+  ;; For that, advice-eval-interactive-spec needs to be more faithful.
+  ;; FIXME: The calls to interactive-form below load autoloaded functions
+  ;; too eagerly.
+  (let ((fspec (cadr (interactive-form function))))
+    (when (eq 'function (car-safe fspec)) ;; Macroexpanded lambda?
+      (setq fspec (nth 1 fspec)))
+    (if (functionp fspec)
+        `(funcall ',fspec
+                  ',(cadr (interactive-form main)))
+  (cadr (or (interactive-form function)
+                (interactive-form main))))))
+
+(defsubst advice--make-1 (byte-code stack-depth function main props)
+  "Build a function value that adds FUNCTION to MAIN."
+  (let ((adv-sig (gethash main advertised-signature-table))
+        (advice
+         (apply #'make-byte-code 128 byte-code
+                (vector #'apply function main props) stack-depth
+                advice--docstring
+                (when (or (commandp function) (commandp main))
+                  (list (advice--make-interactive-form
+                         function main))))))
+    (when adv-sig (puthash advice adv-sig advertised-signature-table))
+    advice))
+
+(defun advice--make (where function main props)
+  "Build a function value that adds FUNCTION to MAIN at WHERE.
+WHERE is a symbol to select an entry in `advice--where-alist'."
+  (let ((desc (assq where advice--where-alist)))
+    (unless desc (error "Unknown add-function location `%S'" where))
+    (advice--make-1 (nth 1 desc) (nth 2 desc)
+                    function main props)))
+
+(defun advice--member-p (function definition)
+  (let ((found nil))
+    (while (and (not found) (advice--p definition))
+      (if (or (equal function (advice--car definition))
+              (equal function (cdr (assq 'name (advice--props definition)))))
+          (setq found t)
+        (setq definition (advice--cdr definition))))
+    found))
+
+;;;###autoload
+(defun advice--remove-function (flist function)
+  (if (not (advice--p flist))
+      flist
+    (let ((first (advice--car flist))
+          (props (advice--props flist)))
+      (if (or (equal function first)
+              (equal function (cdr (assq 'name props))))
+          (advice--cdr flist)
+        (let* ((rest (advice--cdr flist))
+               (nrest (advice--remove-function rest function)))
+          (if (eq rest nrest) flist
+            (advice--make-1 (aref flist 1) (aref flist 3)
+                            first nrest props)))))))
+
+(defvar advice--buffer-local-function-sample nil)
+
+(defun advice--set-buffer-local (var val)
+  (if (function-equal val advice--buffer-local-function-sample)
+      (kill-local-variable var)
+    (set (make-local-variable var) val)))
+
+;;;###autoload
+(defun advice--buffer-local (var)
+  "Buffer-local value of VAR, presumed to contain a function."
+  (declare (gv-setter advice--set-buffer-local))
+  (if (local-variable-p var) (symbol-value var)
+    (setq advice--buffer-local-function-sample
+          (lambda (&rest args) (apply (default-value var) args)))))
+
+;;;###autoload
+(defmacro add-function (where place function &optional props)
+  ;; TODO:
+  ;; - obsolete with-wrapper-hook (mostly requires buffer-local support).
+  ;; - provide some kind of control over ordering.  E.g. debug-on-entry, ELP
+  ;;   and tracing want to stay first.
+  ;; - maybe let `where' specify some kind of predicate and use it
+  ;;   to implement things like mode-local or eieio-defmethod.
+  ;;   Of course, that only makes sense if the predicates of all advices can
+  ;;   be combined and made more efficient.
+  ;; :before is like a normal add-hook on a normal hook.
+  ;; :before-while is like add-hook on run-hook-with-args-until-failure.
+  ;; :before-until is like add-hook on run-hook-with-args-until-success.
+  ;; Same with :after-* but for (add-hook ... 'append).
+  "Add a piece of advice on the function stored at PLACE.
+FUNCTION describes the code to add.  WHERE describes where to add it.
+WHERE can be explained by showing the resulting new function, as the
+result of combining FUNCTION and the previous value of PLACE, which we
+call OLDFUN here:
+`:before'	(lambda (&rest r) (apply FUNCTION r) (apply OLDFUN r))
+`:after'	(lambda (&rest r) (prog1 (apply OLDFUN r) (apply FUNCTION r)))
+`:around'	(lambda (&rest r) (apply FUNCTION OLDFUN r))
+`:before-while'	(lambda (&rest r) (and (apply FUNCTION r) (apply OLDFUN r)))
+`:before-until'	(lambda (&rest r) (or  (apply FUNCTION r) (apply OLDFUN r)))
+`:after-while'	(lambda (&rest r) (and (apply OLDFUN r) (apply FUNCTION r)))
+`:after-until'	(lambda (&rest r) (or  (apply OLDFUN r) (apply FUNCTION r)))
+If FUNCTION was already added, do nothing.
+PROPS is an alist of additional properties, among which the following have
+a special meaning:
+- `name': a string or symbol.  It can be used to refer to this piece of advice.
+
+PLACE cannot be a simple variable.  Instead it should either be
+\(default-value 'VAR) or (local 'VAR) depending on whether FUNCTION
+should be applied to VAR buffer-locally or globally.
+
+If one of FUNCTION or OLDFUN is interactive, then the resulting function
+is also interactive.  There are 3 cases:
+- FUNCTION is not interactive: the interactive spec of OLDFUN is used.
+- The interactive spec of FUNCTION is itself a function: it should take one
+  argument (the interactive spec of OLDFUN, which it can pass to
+  `advice-eval-interactive-spec') and return the list of arguments to use.
+- Else, use the interactive spec of FUNCTION and ignore the one of OLDFUN."
+  (declare (debug t)) ;;(indent 2)
+  (cond ((eq 'local (car-safe place))
+         (setq place `(advice--buffer-local ,@(cdr place))))
+        ((symbolp place)
+         (error "Use (default-value '%S) or (local '%S)" place place)))
+  `(advice--add-function ,where (gv-ref ,place) ,function ,props))
+
+;;;###autoload
+(defun advice--add-function (where ref function props)
+  (unless (advice--member-p function (gv-deref ref))
+    (setf (gv-deref ref)
+          (advice--make where function (gv-deref ref) props))))
+
+(defmacro remove-function (place function)
+  "Remove the FUNCTION piece of advice from PLACE.
+If FUNCTION was not added to PLACE, do nothing.
+Instead of FUNCTION being the actual function, it can also be the `name'
+of the piece of advice."
+  (declare (debug t))
+  (cond ((eq 'local (car-safe place))
+         (setq place `(advice--buffer-local ,@(cdr place))))
+        ((symbolp place)
+         (error "Use (default-value '%S) or (local '%S)" place place)))
+  (gv-letplace (getter setter) place
+    (macroexp-let2 nil new `(advice--remove-function ,getter ,function)
+      `(unless (eq ,new ,getter) ,(funcall setter new)))))
+
+;;;; Specific application of add-function to `symbol-function' for advice.
+
+(defun advice--subst-main (old new)
+  (if (not (advice--p old))
+      new
+    (let* ((first (advice--car old))
+           (rest (advice--cdr old))
+           (props (advice--props old))
+           (nrest (advice--subst-main rest new)))
+      (if (equal rest nrest) old
+        (advice--make-1 (aref old 1) (aref old 3)
+                        first nrest props)))))
+
+(defun advice--normalize (symbol def)
+  (cond
+   ((special-form-p def)
+    ;; Not worth the trouble trying to handle this, I think.
+    (error "advice-add failure: %S is a special form" symbol))
+   ((and (symbolp def)
+	 (eq 'macro (car-safe (ignore-errors (indirect-function def)))))
+    (let ((newval (cons 'macro (cdr (indirect-function def)))))
+      (put symbol 'advice--saved-rewrite (cons def newval))
+      newval))
+   ;; `f' might be a pure (hence read-only) cons!
+   ((and (eq 'macro (car-safe def))
+	 (not (ignore-errors (setcdr def (cdr def)) t)))
+    (cons 'macro (cdr def)))
+   (t def)))
+
+(defsubst advice--strip-macro (x)
+  (if (eq 'macro (car-safe x)) (cdr x) x))
+
+(defun advice--defalias-fset (fsetfun symbol newdef)
+  (when (get symbol 'advice--saved-rewrite)
+    (put symbol 'advice--saved-rewrite nil))
+  (setq newdef (advice--normalize symbol newdef))
+  (let* ((olddef (advice--strip-macro
+		  (if (fboundp symbol) (symbol-function symbol))))
+         (oldadv
+          (cond
+	   ((null (get symbol 'advice--pending))
+	    (or olddef
+		(progn
+		  (message "Delayed advice activation failed for %s: no data"
+			   symbol)
+		  nil)))
+	   ((or (not olddef) (autoloadp olddef))
+	    (prog1 (get symbol 'advice--pending)
+	      (put symbol 'advice--pending nil)))
+           (t (message "Dropping left-over advice--pending for %s" symbol)
+              (put symbol 'advice--pending nil)
+              olddef))))
+    (let* ((snewdef (advice--strip-macro newdef))
+	   (snewadv (advice--subst-main oldadv snewdef)))
+      (funcall (or fsetfun #'fset) symbol
+	       (if (eq snewdef newdef) snewadv (cons 'macro snewadv))))))
+    
+
+;;;###autoload
+(defun advice-add (symbol where function &optional props)
+  "Like `add-function' but for the function named SYMBOL.
+Contrary to `add-function', this will properly handle the cases where SYMBOL
+is defined as a macro, alias, command, ..."
+  ;; TODO:
+  ;; - record the advice location, to display in describe-function.
+  ;; - change all defadvice in lisp/**/*.el.
+  ;; - rewrite advice.el on top of this.
+  ;; - obsolete advice.el.
+  (let* ((f (and (fboundp symbol) (symbol-function symbol)))
+	 (nf (advice--normalize symbol f)))
+    (unless (eq f nf) ;; Most importantly, if nf == nil!
+      (fset symbol nf))
+    (add-function where (cond
+                         ((eq (car-safe nf) 'macro) (cdr nf))
+                         ;; Reasons to delay installation of the advice:
+                         ;; - If the function is not yet defined, installing
+                         ;;   the advice would affect `fboundp'ness.
+                         ;; - If it's an autoloaded command,
+                         ;;   advice--make-interactive-form would end up
+                         ;;   loading the command eagerly.
+                         ;; - `autoload' does nothing if the function is
+                         ;;   not an autoload or undefined.
+                         ((or (not nf) (autoloadp nf))
+                          (get symbol 'advice--pending))
+                         (t (symbol-function symbol)))
+                  function props)
+    (add-function :around (get symbol 'defalias-fset-function)
+                  #'advice--defalias-fset))
+  nil)
+
+;;;###autoload
+(defun advice-remove (symbol function)
+  "Like `remove-function' but for the function named SYMBOL.
+Contrary to `remove-function', this will work also when SYMBOL is a macro
+and it will not signal an error if SYMBOL is not `fboundp'.
+Instead of the actual function to remove, FUNCTION can also be the `name'
+of the piece of advice."
+  (when (fboundp symbol)
+    (let ((f (symbol-function symbol)))
+      ;; Can't use the `if' place here, because the body is too large,
+      ;; resulting in use of code that only works with lexical-scoping.
+      (remove-function (if (eq (car-safe f) 'macro)
+                           (cdr f)
+                         (symbol-function symbol))
+                       function)
+      (unless (advice--p
+               (if (eq (car-safe f) 'macro) (cdr f) (symbol-function symbol)))
+        ;; Not advised any more.
+        (remove-function (get symbol 'defalias-fset-function)
+                         #'advice--defalias-fset)
+        (if (eq (symbol-function symbol)
+                (cdr (get symbol 'advice--saved-rewrite)))
+            (fset symbol (car (get symbol 'advice--saved-rewrite))))))
+    nil))
+
+;; (defun advice-mapc (fun symbol)
+;;   "Apply FUN to every function added as advice to SYMBOL.
+;; FUN is called with a two arguments: the function that was added, and the
+;; properties alist that was specified when it was added."
+;;   (let ((def (or (get symbol 'advice--pending)
+;;                  (if (fboundp symbol) (symbol-function symbol)))))
+;;     (while (advice--p def)
+;;       (funcall fun (advice--car def) (advice--props def))
+;;       (setq def (advice--cdr def)))))
+
+;;;###autoload
+(defun advice-member-p (advice function-name)
+  "Return non-nil if ADVICE has been added to FUNCTION-NAME.
+Instead of ADVICE being the actual function, it can also be the `name'
+of the piece of advice."
+  (advice--member-p advice
+                    (or (get function-name 'advice--pending)
+			(advice--strip-macro
+			 (if (fboundp function-name)
+			     (symbol-function function-name))))))
+
+;; When code is advised, called-interactively-p needs to be taught to skip
+;; the advising frames.
+;; FIXME: This Major Ugly Hack won't handle calls to called-interactively-p
+;; done from the advised function if the deepest advice is an around advice!
+;; In other cases (calls from an advice or calls from the advised function when
+;; the deepest advice is not an around advice), it should hopefully get
+;; it right.
+(add-hook 'called-interactively-p-functions
+          #'advice--called-interactively-skip)
+(defun advice--called-interactively-skip (origi frame1 frame2)
+  (let* ((i origi)
+         (get-next-frame
+          (lambda ()
+            (setq frame1 frame2)
+            (setq frame2 (internal--called-interactively-p--get-frame i))
+            ;; (message "Advice Frame %d = %S" i frame2)
+            (setq i (1+ i)))))
+    (when (and (eq (nth 1 frame2) 'apply)
+               (progn
+                 (funcall get-next-frame)
+                 (advice--p (indirect-function (nth 1 frame2)))))
+      (funcall get-next-frame)
+      ;; If we now have the symbol, this was the head advice and
+      ;; we're done.
+      (while (advice--p (nth 1 frame1))
+        ;; This was an inner advice called from some earlier advice.
+        ;; The stack frames look different depending on the particular
+        ;; kind of the earlier advice.
+        (let ((inneradvice (nth 1 frame1)))
+          (if (and (eq (nth 1 frame2) 'apply)
+                   (progn
+                     (funcall get-next-frame)
+                     (advice--p (indirect-function
+                                 (nth 1 frame2)))))
+              ;; The earlier advice was something like a before/after
+              ;; advice where the "next" code is called directly by the
+              ;; advice--p object.
+              (funcall get-next-frame)
+            ;; It's apparently an around advice, where the "next" is
+            ;; called by the body of the advice in any way it sees fit,
+            ;; so we need to skip the frames of that body.
+            (while
+                (progn
+                  (funcall get-next-frame)
+                  (not (and (eq (nth 1 frame2) 'apply)
+                            (eq (nth 3 frame2) inneradvice)))))
+            (funcall get-next-frame)
+            (funcall get-next-frame))))
+      (- i origi 1))))
+
+
+(provide 'nadvice)
+;;; nadvice.el ends here
diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el
index cd4b5ee231c..0b6fd277ae2 100644
--- a/lisp/emacs-lisp/package-x.el
+++ b/lisp/emacs-lisp/package-x.el
@@ -1,6 +1,6 @@
 ;;; package-x.el --- Package extras
 
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
 
 ;; Author: Tom Tromey <tromey@redhat.com>
 ;; Created: 10 Mar 2007
@@ -10,10 +10,10 @@
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, 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
@@ -21,9 +21,7 @@
 ;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index a1513039a98..6629410a1f1 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -1,18 +1,18 @@
 ;;; package.el --- Simple package system for Emacs
 
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
 
 ;; Author: Tom Tromey <tromey@redhat.com>
 ;; Created: 10 Mar 2007
-;; Version: 0.9
+;; Version: 1.0
 ;; Keywords: tools
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, 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
@@ -20,9 +20,7 @@
 ;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Change Log:
 
@@ -382,30 +380,37 @@ controls which package subdirectories may be loaded.
 In each valid package subdirectory, this function loads the
 description file containing a call to `define-package', which
 updates `package-alist' and `package-obsolete-alist'."
-  (let ((all (memq 'all package-load-list))
-	(regexp (concat "\\`" package-subdirectory-regexp "\\'"))
-	name version force)
+  (let ((regexp (concat "\\`" package-subdirectory-regexp "\\'")))
     (dolist (dir (cons package-user-dir package-directory-list))
       (when (file-directory-p dir)
 	(dolist (subdir (directory-files dir))
-	  (when (and (file-directory-p (expand-file-name subdir dir))
-		     (string-match regexp subdir))
-	    (setq name    (intern (match-string 1 subdir))
-		  version (match-string 2 subdir)
-		  force   (assq name package-load-list))
-	    (when (cond
-		   ((null force)
-		    all) ; not in package-load-list
-		   ((null (setq force (cadr force)))
-		    nil) ; disabled
-		   ((eq force t)
-		    t)
-		   ((stringp force) ; held
-		    (version-list-= (version-to-list version)
-				    (version-to-list force)))
-		   (t
-		    (error "Invalid element in `package-load-list'")))
-	      (package-load-descriptor dir subdir))))))))
+	  (when (string-match regexp subdir)
+	    (package-maybe-load-descriptor (match-string 1 subdir)
+					   (match-string 2 subdir)
+					   dir)))))))
+
+(defun package-maybe-load-descriptor (name version dir)
+  "Maybe load a specific package from directory DIR.
+NAME and VERSION are the package's name and version strings.
+This function checks `package-load-list', before actually loading
+the package by calling `package-load-descriptor'."
+  (let ((force (assq (intern name) package-load-list))
+	(subdir (concat name "-" version)))
+    (and (file-directory-p (expand-file-name subdir dir))
+	 ;; Check `package-load-list':
+	 (cond ((null force)
+		(memq 'all package-load-list))
+	       ((null (setq force (cadr force)))
+		nil) ; disabled
+	       ((eq force t)
+		t)
+	       ((stringp force) ; held
+		(version-list-= (version-to-list version)
+				(version-to-list force)))
+	       (t
+		(error "Invalid element in `package-load-list'")))
+	 ;; Actually load the descriptor:
+	 (package-load-descriptor dir subdir))))
 
 (defsubst package-desc-vers (desc)
   "Extract version from a package description vector."
@@ -462,8 +467,11 @@ NAME and VERSION are both strings."
 Optional arg MIN-VERSION, if non-nil, should be a version list
 specifying the minimum acceptable version."
   (require 'finder-inf nil t) ; For `package--builtins'.
-  (let ((elt (assq package package--builtins)))
-    (and elt (version-list-<= min-version (package-desc-vers (cdr elt))))))
+  (if (eq package 'emacs)
+      (version-list-<= min-version (version-to-list emacs-version))
+    (let ((elt (assq package package--builtins)))
+      (and elt (version-list-<= min-version
+				(package-desc-vers (cdr elt)))))))
 
 ;; This function goes ahead and activates a newer version of a package
 ;; if an older one was already activated.  This is not ideal; we'd at
@@ -517,7 +525,7 @@ Required package `%s-%s' is unavailable"
 
 (defun define-package (name-string version-string
 				&optional docstring requirements
-				&rest extra-properties)
+				&rest _extra-properties)
   "Define a new package.
 NAME-STRING is the name of the package, as a string.
 VERSION-STRING is the version of the package, as a string.
@@ -577,12 +585,14 @@ EXTRA-PROPERTIES is currently unused."
 (defun package-generate-autoloads (name pkg-dir)
   (require 'autoload)         ;Load before we let-bind generated-autoload-file!
   (let* ((auto-name (concat name "-autoloads.el"))
-	 (ignore-name (concat name "-pkg.el"))
+	 ;;(ignore-name (concat name "-pkg.el"))
 	 (generated-autoload-file (expand-file-name auto-name pkg-dir))
 	 (version-control 'never))
     (unless (fboundp 'autoload-ensure-default-file)
       (package-autoload-ensure-default-file generated-autoload-file))
-    (update-directory-autoloads pkg-dir)))
+    (update-directory-autoloads pkg-dir)
+    (let ((buf (find-buffer-visiting generated-autoload-file)))
+      (when buf (kill-buffer buf)))))
 
 (defvar tar-parse-info)
 (declare-function tar-untar-buffer "tar-mode" ())
@@ -600,16 +610,25 @@ untar into a directory named DIR; otherwise, signal an error."
 	(error "Package does not untar cleanly into directory %s/" dir))))
   (tar-untar-buffer))
 
-(defun package-unpack (name version)
-  (let* ((dirname (concat (symbol-name name) "-" version))
+(defun package-unpack (package version)
+  (let* ((name (symbol-name package))
+	 (dirname (concat name "-" version))
 	 (pkg-dir (expand-file-name dirname package-user-dir)))
     (make-directory package-user-dir t)
     ;; FIXME: should we delete PKG-DIR if it exists?
     (let* ((default-directory (file-name-as-directory package-user-dir)))
       (package-untar-buffer dirname)
-      (package-generate-autoloads (symbol-name name) pkg-dir)
-      (let ((load-path (cons pkg-dir load-path)))
-	(byte-recompile-directory pkg-dir 0 t)))))
+      (package--make-autoloads-and-compile name pkg-dir))))
+
+(defun package--make-autoloads-and-compile (name pkg-dir)
+  "Generate autoloads and do byte-compilation for package named NAME.
+PKG-DIR is the name of the package directory."
+  (package-generate-autoloads name pkg-dir)
+  (let ((load-path (cons pkg-dir load-path)))
+    ;; We must load the autoloads file before byte compiling, in
+    ;; case there are magic cookies to set up non-trivial paths.
+    (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t)
+    (byte-recompile-directory pkg-dir 0 t)))
 
 (defun package--write-file-no-coding (file-name)
   (let ((buffer-file-coding-system 'no-conversion))
@@ -649,9 +668,7 @@ untar into a directory named DIR; otherwise, signal an error."
 	 nil
 	 pkg-file
 	 nil nil nil 'excl))
-      (package-generate-autoloads file-name pkg-dir)
-      (let ((load-path (cons pkg-dir load-path)))
-	(byte-recompile-directory pkg-dir 0 t)))))
+      (package--make-autoloads-and-compile file-name pkg-dir))))
 
 (defmacro package--with-work-buffer (location file &rest body)
   "Run BODY in a buffer containing the contents of FILE at LOCATION.
@@ -713,6 +730,7 @@ It will move point to somewhere in the headers."
 (defun package-installed-p (package &optional min-version)
   "Return true if PACKAGE, of MIN-VERSION or newer, is installed.
 MIN-VERSION should be a version list."
+  (unless package--initialized (error "package.el is not yet initialized!"))
   (let ((pkg-desc (assq package package-alist)))
     (if pkg-desc
 	(version-list-<= min-version
@@ -743,7 +761,8 @@ not included in this list."
 	      hold)
 	  (when (setq hold (assq next-pkg package-load-list))
 	    (setq hold (cadr hold))
-	    (cond ((eq hold nil)
+	    (cond ((eq hold t))
+		  ((eq hold nil)
 		   (error "Required package '%s' is disabled"
 			  (symbol-name next-pkg)))
 		  ((null (stringp hold))
@@ -861,7 +880,13 @@ using `package-compute-transaction'."
 				 (package-desc-doc desc)
 				 (package-desc-reqs desc)))
        (t
-	(error "Unknown package kind: %s" (symbol-name kind)))))))
+	(error "Unknown package kind: %s" (symbol-name kind))))
+      ;; If package A depends on package B, then A may `require' B
+      ;; during byte compilation.  So we need to activate B before
+      ;; unpacking A.
+      (package-maybe-load-descriptor (symbol-name elt) v-string
+				     package-user-dir)
+      (package-activate elt (version-to-list v-string)))))
 
 (defvar package--initialized nil)
 
@@ -876,6 +901,8 @@ archive in `package-archives'.  Interactively, prompt for NAME."
      ;; symbols for completion.
      (unless package--initialized
        (package-initialize t))
+     (unless package-archive-contents
+       (package-refresh-contents))
      (list (intern (completing-read
 		    "Install package: "
 		    (mapcar (lambda (elt)
@@ -889,9 +916,7 @@ archive in `package-archives'.  Interactively, prompt for NAME."
 	     (symbol-name name)))
     (package-download-transaction
      (package-compute-transaction (list name)
-				  (package-desc-reqs (cdr pkg-desc)))))
-  ;; Try to activate it.
-  (package-initialize))
+				  (package-desc-reqs (cdr pkg-desc))))))
 
 (defun package-strip-rcs-id (str)
   "Strip RCS version ID from the version string STR.
@@ -922,7 +947,7 @@ If the buffer does not contain a conforming package, signal an
 error.  If there is a package, narrow the buffer to the file's
 boundaries."
   (goto-char (point-min))
-  (unless (re-search-forward "^;;; \\([^ ]*\\)\\.el --- \\(.*\\)$" nil t)
+  (unless (re-search-forward "^;;; \\([^ ]*\\)\\.el ---[ \t]*\\(.*?\\)[ \t]*\\(-\\*-.*-\\*-[ \t]*\\)?$" nil t)
     (error "Packages lacks a file header"))
   (let ((file-name (match-string-no-properties 1))
 	(desc      (match-string-no-properties 2))
@@ -1090,7 +1115,7 @@ makes them available for download."
   (unless (file-exists-p package-user-dir)
     (make-directory package-user-dir t))
   (dolist (archive package-archives)
-    (condition-case-no-debug nil
+    (condition-case-unless-debug nil
 	(package--download-one-archive archive "archive-contents")
       (error (message "Failed to download `%s' archive."
 		      (car archive)))))
@@ -1338,6 +1363,9 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages."
     map)
   "Local keymap for `package-menu-mode' buffers.")
 
+(defvar package-menu--new-package-list nil
+  "List of newly-available packages since `list-packages' was last called.")
+
 (define-derived-mode package-menu-mode tabulated-list-mode "Package Menu"
   "Major mode for browsing a list of packages.
 Letters do not insert themselves; instead, they are commands.
@@ -1368,7 +1396,7 @@ If REMEMBER-POS is non-nil, keep point on the same entry.
 PACKAGES should be t, which means to display all known packages,
 or a list of package names (symbols) to display."
   ;; Construct list of ((PACKAGE . VERSION) STATUS DESCRIPTION).
-  (let (info-list name builtin)
+  (let (info-list name)
     ;; Installed packages:
     (dolist (elt package-alist)
       (setq name (car elt))
@@ -1391,9 +1419,10 @@ or a list of package names (symbols) to display."
       (when (or (eq packages t) (memq name packages))
 	(let ((hold (assq name package-load-list)))
 	  (package--push name (cdr elt)
-			 (if (and hold (null (cadr hold)))
-			     "disabled"
-			   "available")
+			 (cond
+			  ((and hold (null (cadr hold))) "disabled")
+			  ((memq name package-menu--new-package-list) "new")
+			  (t "available"))
 			 info-list))))
 
     ;; Obsolete packages:
@@ -1418,6 +1447,7 @@ identifier (NAME . VERSION-LIST)."
 	 (face (cond
 		((string= status "built-in")  'font-lock-builtin-face)
 		((string= status "available") 'default)
+		((string= status "new") 'bold)
 		((string= status "held")      'font-lock-constant-face)
 		((string= status "disabled")  'font-lock-warning-face)
 		((string= status "installed") 'font-lock-comment-face)
@@ -1453,21 +1483,21 @@ If optional arg BUTTON is non-nil, describe its associated package."
 	(describe-package package))))
 
 ;; fixme numeric argument
-(defun package-menu-mark-delete (&optional num)
+(defun package-menu-mark-delete (&optional _num)
   "Mark a package for deletion and move to the next line."
   (interactive "p")
   (if (member (package-menu-get-status) '("installed" "obsolete"))
       (tabulated-list-put-tag "D" t)
     (forward-line)))
 
-(defun package-menu-mark-install (&optional num)
+(defun package-menu-mark-install (&optional _num)
   "Mark a package for installation and move to the next line."
   (interactive "p")
-  (if (string-equal (package-menu-get-status) "available")
+  (if (member (package-menu-get-status) '("available" "new"))
       (tabulated-list-put-tag "I" t)
     (forward-line)))
 
-(defun package-menu-mark-unmark (&optional num)
+(defun package-menu-mark-unmark (&optional _num)
   "Clear any marks on a package and move to the next line."
   (interactive "p")
   (tabulated-list-put-tag " " t))
@@ -1509,11 +1539,10 @@ If optional arg BUTTON is non-nil, describe its associated package."
     (dolist (entry tabulated-list-entries)
       ;; ENTRY is ((NAME . VERSION) [NAME VERSION STATUS DOC])
       (let ((pkg (car entry))
-	    (status (aref (cadr entry) 2))
-	    old)
+	    (status (aref (cadr entry) 2)))
 	(cond ((equal status "installed")
 	       (push pkg installed))
-	      ((equal status "available")
+	      ((member status '("available" "new"))
 	       (push pkg available)))))
     ;; Loop through list of installed packages, finding upgrades
     (dolist (pkg installed)
@@ -1595,7 +1624,7 @@ packages marked for deletion are removed."
 				delete-list
 				", "))))
 	  (dolist (elt delete-list)
-	    (condition-case-no-debug err
+	    (condition-case-unless-debug err
 		(package-delete (car elt) (cdr elt))
 	      (error (message (cadr err)))))
 	(error "Aborted")))
@@ -1619,16 +1648,18 @@ packages marked for deletion are removed."
 	(sB (aref (cadr B) 2)))
     (cond ((string= sA sB)
 	   (package-menu--name-predicate A B))
-	  ((string= sA  "available") t)
+	  ((string= sA "new") t)
+	  ((string= sB "new") nil)
+	  ((string= sA "available") t)
 	  ((string= sB "available") nil)
-	  ((string= sA  "installed") t)
+	  ((string= sA "installed") t)
 	  ((string= sB "installed") nil)
-	  ((string= sA  "held") t)
+	  ((string= sA "held") t)
 	  ((string= sB "held") nil)
-	  ((string= sA  "built-in") t)
+	  ((string= sA "built-in") t)
 	  ((string= sB "built-in") nil)
-	  ((string= sA  "obsolete") t)
-	  ((string= sB  "obsolete") nil)
+	  ((string= sA "obsolete") t)
+	  ((string= sB "obsolete") nil)
 	  (t (string< sA sB)))))
 
 (defun package-menu--description-predicate (A B)
@@ -1653,22 +1684,36 @@ The list is displayed in a buffer named `*Packages*'."
   ;; Initialize the package system if necessary.
   (unless package--initialized
     (package-initialize t))
-  (unless no-fetch
-    (package-refresh-contents))
-  (let ((buf (get-buffer-create "*Packages*")))
-    (with-current-buffer buf
-      (package-menu-mode)
-      (package-menu--generate nil t))
-    ;; The package menu buffer has keybindings.  If the user types
-    ;; `M-x list-packages', that suggests it should become current.
-    (switch-to-buffer buf))
-  (let ((upgrades (package-menu--find-upgrades)))
-    (if upgrades
-	(message "%d package%s can be upgraded; type `%s' to mark %s for upgrading."
-		 (length upgrades)
-		 (if (= (length upgrades) 1) "" "s")
-		 (substitute-command-keys "\\[package-menu-mark-upgrades]")
-		 (if (= (length upgrades) 1) "it" "them")))))
+  (let (old-archives new-packages)
+    (unless no-fetch
+      ;; Read the locally-cached archive-contents.
+      (package-read-all-archive-contents)
+      (setq old-archives package-archive-contents)
+      ;; Fetch the remote list of packages.
+      (package-refresh-contents)
+      ;; Find which packages are new.
+      (dolist (elt package-archive-contents)
+	(unless (assq (car elt) old-archives)
+	  (push (car elt) new-packages))))
+
+    ;; Generate the Package Menu.
+    (let ((buf (get-buffer-create "*Packages*")))
+      (with-current-buffer buf
+	(package-menu-mode)
+	(set (make-local-variable 'package-menu--new-package-list)
+	     new-packages)
+	(package-menu--generate nil t))
+      ;; The package menu buffer has keybindings.  If the user types
+      ;; `M-x list-packages', that suggests it should become current.
+      (switch-to-buffer buf))
+
+    (let ((upgrades (package-menu--find-upgrades)))
+      (if upgrades
+	  (message "%d package%s can be upgraded; type `%s' to mark %s for upgrading."
+		   (length upgrades)
+		   (if (= (length upgrades) 1) "" "s")
+		   (substitute-command-keys "\\[package-menu-mark-upgrades]")
+		   (if (= (length upgrades) 1) "it" "them"))))))
 
 ;;;###autoload
 (defalias 'package-list-packages 'list-packages)
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 6931ce75cb5..1312fc3731d 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -1,6 +1,6 @@
-;;; pcase.el --- ML-style pattern-matching macro for Elisp -*- lexical-binding: t -*-
+;;; pcase.el --- ML-style pattern-matching macro for Elisp -*- lexical-binding: t; coding: utf-8 -*-
 
-;; Copyright (C) 2010-2011  Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012  Free Software Foundation, Inc.
 
 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
 ;; Keywords:
@@ -39,25 +39,55 @@
 ;; - along these lines, provide patterns to match CL structs.
 ;; - provide something like (setq VAR) so a var can be set rather than
 ;;   let-bound.
-;; - provide a way to fallthrough to subsequent cases.
+;; - provide a way to fallthrough to subsequent cases (not sure what I meant by
+;;   this :-()
 ;; - try and be more clever to reduce the size of the decision tree, and
 ;;   to reduce the number of leaves that need to be turned into function:
 ;;   - first, do the tests shared by all remaining branches (it will have
-;;     to be performed anyway, so better so it first so it's shared).
+;;     to be performed anyway, so better do it first so it's shared).
 ;;   - then choose the test that discriminates more (?).
+;; - provide Agda's `with' (along with its `...' companion).
+;; - implement (not UPAT).  This might require a significant redesign.
 ;; - ideally we'd want (pcase s ((re RE1) E1) ((re RE2) E2)) to be able to
 ;;   generate a lex-style DFA to decide whether to run E1 or E2.
 
 ;;; Code:
 
+(require 'macroexp)
+
 ;; Macro-expansion of pcase is reasonably fast, so it's not a problem
 ;; when byte-compiling a file, but when interpreting the code, if the pcase
 ;; is in a loop, the repeated macro-expansion becomes terribly costly, so we
 ;; memoize previous macro expansions to try and avoid recomputing them
 ;; over and over again.
+;; FIXME: Now that macroexpansion is also performed when loading an interpreted
+;; file, this is not a real problem any more.
 (defconst pcase--memoize (make-hash-table :weakness 'key :test 'eq))
-
-(defconst pcase--dontcare-upats '(t _ dontcare))
+;; (defconst pcase--memoize-1 (make-hash-table :test 'eq))
+;; (defconst pcase--memoize-2 (make-hash-table :weakness 'key :test 'equal))
+
+(defconst pcase--dontcare-upats '(t _ pcase--dontcare))
+
+(def-edebug-spec
+  pcase-UPAT
+  (&or symbolp
+       ("or" &rest pcase-UPAT)
+       ("and" &rest pcase-UPAT)
+       ("`" pcase-QPAT)
+       ("guard" form)
+       ("let" pcase-UPAT form)
+       ("pred"
+        &or lambda-expr
+        ;; Punt on macros/special forms.
+        (functionp &rest form)
+        sexp)
+       sexp))
+
+(def-edebug-spec
+  pcase-QPAT
+  (&or ("," pcase-UPAT)
+       (pcase-QPAT . pcase-QPAT)
+       sexp))
 
 ;;;###autoload
 (defmacro pcase (exp &rest cases)
@@ -66,6 +96,7 @@ CASES is a list of elements of the form (UPATTERN CODE...).
 
 UPatterns can take the following forms:
   _		matches anything.
+  SELFQUOTING	matches itself.  This includes keywords, numbers, and strings.
   SYMBOL	matches anything and binds it to SYMBOL.
   (or UPAT...)	matches if any of the patterns matches.
   (and UPAT...)	matches if all the patterns match.
@@ -85,13 +116,14 @@ QPatterns for vectors are not implemented yet.
 
 PRED can take the form
   FUNCTION	     in which case it gets called with one argument.
-  (FUN ARG1 .. ARGN) in which case it gets called with N+1 arguments.
+  (FUN ARG1 .. ARGN) in which case it gets called with an N+1'th argument
+                        which is the value being matched.
 A PRED of the form FUNCTION is equivalent to one of the form (FUNCTION).
 PRED patterns can refer to variables bound earlier in the pattern.
 E.g. you can match pairs where the cdr is larger than the car with a pattern
 like `(,a . ,(pred (< a))) or, with more checks:
 `(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a))))"
-  (declare (indent 1) (debug case))     ;FIXME: edebug `guard' and vars.
+  (declare (indent 1) (debug (form &rest (pcase-UPAT body))))
   ;; We want to use a weak hash table as a cache, but the key will unavoidably
   ;; be based on `exp' and `cases', yet `cases' is a fresh new list each time
   ;; we're called so it'll be immediately GC'd.  So we use (car cases) as key
@@ -102,37 +134,57 @@ like `(,a . ,(pred (< a))) or, with more checks:
     (if (and (equal exp (car data)) (equal cases (cadr data)))
         ;; We have the right expansion.
         (cddr data)
+      ;; (when (gethash (car cases) pcase--memoize-1)
+      ;;   (message "pcase-memoize failed because of weak key!!"))
+      ;; (when (gethash (car cases) pcase--memoize-2)
+      ;;   (message "pcase-memoize failed because of eq test on %S"
+      ;;            (car cases)))
       (when data
         (message "pcase-memoize: equal first branch, yet different"))
       (let ((expansion (pcase--expand exp cases)))
-        (puthash (car cases) (cons exp (cons cases expansion)) pcase--memoize)
+        (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize)
+        ;; (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize-1)
+        ;; (puthash (car cases) `(,exp ,cases ,@expansion) pcase--memoize-2)
         expansion))))
 
+(defun pcase--let* (bindings body)
+  (cond
+   ((null bindings) (macroexp-progn body))
+   ((pcase--trivial-upat-p (caar bindings))
+    (macroexp-let* `(,(car bindings)) (pcase--let* (cdr bindings) body)))
+   (t
+    (let ((binding (pop bindings)))
+      (pcase--expand
+       (cadr binding)
+       `((,(car binding) ,(pcase--let* bindings body))
+         ;; We can either signal an error here, or just use `pcase--dontcare'
+         ;; which generates more efficient code.  In practice, if we use
+         ;; `pcase--dontcare' we will still often get an error and the few
+         ;; cases where we don't do not matter that much, so
+         ;; it's a better choice.
+         (pcase--dontcare nil)))))))
+
 ;;;###autoload
 (defmacro pcase-let* (bindings &rest body)
   "Like `let*' but where you can use `pcase' patterns for bindings.
 BODY should be an expression, and BINDINGS should be a list of bindings
 of the form (UPAT EXP)."
-  (declare (indent 1) (debug let))
-  (cond
-   ((null bindings) (if (> (length body) 1) `(progn ,@body) (car body)))
-   ((pcase--trivial-upat-p (caar bindings))
-    `(let (,(car bindings)) (pcase-let* ,(cdr bindings) ,@body)))
-   (t
-    `(pcase ,(cadr (car bindings))
-       (,(caar bindings) (pcase-let* ,(cdr bindings) ,@body))
-       ;; We can either signal an error here, or just use `dontcare' which
-       ;; generates more efficient code.  In practice, if we use `dontcare' we
-       ;; will still often get an error and the few cases where we don't do not
-       ;; matter that much, so it's a better choice.
-       (dontcare nil)))))
+  (declare (indent 1)
+           (debug ((&rest (pcase-UPAT &optional form)) body)))
+  (let ((cached (gethash bindings pcase--memoize)))
+    ;; cached = (BODY . EXPANSION)
+    (if (equal (car cached) body)
+        (cdr cached)
+      (let ((expansion (pcase--let* bindings body)))
+        (puthash bindings (cons body expansion) pcase--memoize)
+        expansion))))
 
 ;;;###autoload
 (defmacro pcase-let (bindings &rest body)
   "Like `let' but where you can use `pcase' patterns for bindings.
 BODY should be a list of expressions, and BINDINGS should be a list of bindings
 of the form (UPAT EXP)."
-  (declare (indent 1) (debug let))
+  (declare (indent 1) (debug pcase-let*))
   (if (null (cdr bindings))
       `(pcase-let* ,bindings ,@body)
     (let ((matches '()))
@@ -148,6 +200,7 @@ of the form (UPAT EXP)."
       `(let ,(nreverse bindings) (pcase-let* ,matches ,@body)))))
 
 (defmacro pcase-dolist (spec &rest body)
+  (declare (indent 1) (debug ((pcase-UPAT form) body)))
   (if (pcase--trivial-upat-p (car spec))
       `(dolist ,spec ,@body)
     (let ((tmpvar (make-symbol "x")))
@@ -162,64 +215,78 @@ of the form (UPAT EXP)."
 (defun pcase--expand (exp cases)
   ;; (message "pid=%S (pcase--expand %S ...hash=%S)"
   ;;          (emacs-pid) exp (sxhash cases))
-  (let* ((defs (if (symbolp exp) '()
-                 (let ((sym (make-symbol "x")))
-                   (prog1 `((,sym ,exp)) (setq exp sym)))))
-         (seen '())
-         (codegen
-          (lambda (code vars)
-            (let ((prev (assq code seen)))
-              (if (not prev)
-                  (let ((res (pcase-codegen code vars)))
-                    (push (list code vars res) seen)
-                    res)
-                ;; Since we use a tree-based pattern matching
-                ;; technique, the leaves (the places that contain the
-                ;; code to run once a pattern is matched) can get
-                ;; copied a very large number of times, so to avoid
-                ;; code explosion, we need to keep track of how many
-                ;; times we've used each leaf and move it
-                ;; to a separate function if that number is too high.
-                ;;
-                ;; We've already used this branch.  So it is shared.
-                (let* ((code (car prev))         (cdrprev (cdr prev))
-                       (prevvars (car cdrprev))  (cddrprev (cdr cdrprev))
-                       (res (car cddrprev)))
-                  (unless (symbolp res)
-                    ;; This is the first repeat, so we have to move
-                    ;; the branch to a separate function.
-                    (let ((bsym
-                           (make-symbol (format "pcase-%d" (length defs)))))
-                      (push `(,bsym (lambda ,(mapcar #'car prevvars) ,@code)) defs)
-                      (setcar res 'funcall)
-                      (setcdr res (cons bsym (mapcar #'cdr prevvars)))
-                      (setcar (cddr prev) bsym)
-                      (setq res bsym)))
-                  (setq vars (copy-sequence vars))
-                  (let ((args (mapcar (lambda (pa)
-                                        (let ((v (assq (car pa) vars)))
-                                          (setq vars (delq v vars))
-                                          (cdr v)))
-                                      prevvars)))
-                    (when vars          ;New additional vars.
-                      (error "The vars %s are only bound in some paths"
-                             (mapcar #'car vars)))
-                    `(funcall ,res ,@args)))))))
-         (main
-          (pcase--u
-           (mapcar (lambda (case)
-                     `((match ,exp . ,(car case))
-                       ,(apply-partially
-                         (if (pcase--small-branch-p (cdr case))
-                             ;; Don't bother sharing multiple
-                             ;; occurrences of this leaf since it's small.
-                             #'pcase-codegen codegen)
-                         (cdr case))))
-                   cases))))
-    (if (null defs) main
-      `(let ,defs ,main))))
+  (macroexp-let2 macroexp-copyable-p val exp
+    (let* ((defs ())
+           (seen '())
+           (codegen
+            (lambda (code vars)
+              (let ((prev (assq code seen)))
+                (if (not prev)
+                    (let ((res (pcase-codegen code vars)))
+                      (push (list code vars res) seen)
+                      res)
+                  ;; Since we use a tree-based pattern matching
+                  ;; technique, the leaves (the places that contain the
+                  ;; code to run once a pattern is matched) can get
+                  ;; copied a very large number of times, so to avoid
+                  ;; code explosion, we need to keep track of how many
+                  ;; times we've used each leaf and move it
+                  ;; to a separate function if that number is too high.
+                  ;;
+                  ;; We've already used this branch.  So it is shared.
+                  (let* ((code (car prev))         (cdrprev (cdr prev))
+                         (prevvars (car cdrprev))  (cddrprev (cdr cdrprev))
+                         (res (car cddrprev)))
+                    (unless (symbolp res)
+                      ;; This is the first repeat, so we have to move
+                      ;; the branch to a separate function.
+                      (let ((bsym
+                             (make-symbol (format "pcase-%d" (length defs)))))
+                        (push `(,bsym (lambda ,(mapcar #'car prevvars) ,@code))
+                              defs)
+                        (setcar res 'funcall)
+                        (setcdr res (cons bsym (mapcar #'cdr prevvars)))
+                        (setcar (cddr prev) bsym)
+                        (setq res bsym)))
+                    (setq vars (copy-sequence vars))
+                    (let ((args (mapcar (lambda (pa)
+                                          (let ((v (assq (car pa) vars)))
+                                            (setq vars (delq v vars))
+                                            (cdr v)))
+                                        prevvars)))
+                      ;; If some of `vars' were not found in `prevvars', that's
+                      ;; OK it just means those vars aren't present in all
+                      ;; branches, so they can be used within the pattern
+                      ;; (e.g. by a `guard/let/pred') but not in the branch.
+                      ;; FIXME: But if some of `prevvars' are not in `vars' we
+                      ;; should remove them from `prevvars'!
+                      `(funcall ,res ,@args)))))))
+           (used-cases ())
+           (main
+            (pcase--u
+             (mapcar (lambda (case)
+                       `((match ,val . ,(car case))
+                         ,(lambda (vars)
+                            (unless (memq case used-cases)
+                              ;; Keep track of the cases that are used.
+                              (push case used-cases))
+                            (funcall
+                             (if (pcase--small-branch-p (cdr case))
+                                 ;; Don't bother sharing multiple
+                                 ;; occurrences of this leaf since it's small.
+                                 #'pcase-codegen codegen)
+                             (cdr case)
+                             vars))))
+                     cases))))
+      (dolist (case cases)
+        (unless (or (memq case used-cases) (eq (car case) 'pcase--dontcare))
+          (message "Redundant pcase pattern: %S" (car case))))
+      (macroexp-let* defs main))))
 
 (defun pcase-codegen (code vars)
+  ;; Don't use let*, otherwise macroexp-let* may merge it with some surrounding
+  ;; let* which might prevent the setcar/setcdr in pcase--expand's fancy
+  ;; codegen from later metamorphosing this let into a funcall.
   `(let ,(mapcar (lambda (b) (list (car b) (cdr b))) vars)
      ,@code))
 
@@ -237,23 +304,7 @@ of the form (UPAT EXP)."
   (cond
    ((eq else :pcase--dontcare) then)
    ((eq then :pcase--dontcare) (debug) else) ;Can/should this ever happen?
-   ((eq (car-safe else) 'if)
-    (if (equal test (nth 1 else))
-        ;; Doing a test a second time: get rid of the redundancy.
-        ;; FIXME: ideally, this should never happen because the pcase--split-*
-        ;; funs should have eliminated such things, but pcase--split-member
-        ;; is imprecise, so in practice it can happen occasionally.
-        `(if ,test ,then ,@(nthcdr 3 else))
-      `(cond (,test ,then)
-             (,(nth 1 else) ,(nth 2 else))
-             (t ,@(nthcdr 3 else)))))
-   ((eq (car-safe else) 'cond)
-    `(cond (,test ,then)
-           ;; Doing a test a second time: get rid of the redundancy, as above.
-           ,@(remove (assoc test else) (cdr else))))
-   ;; Invert the test if that lets us reduce the depth of the tree.
-   ((memq (car-safe then) '(if cond)) (pcase--if `(not ,test) else then))
-   (t `(if ,test ,then ,else))))
+   (t (macroexp-if test then else))))
 
 (defun pcase--upat (qpattern)
   (cond
@@ -433,26 +484,26 @@ MATCH is the pattern that needs to be matched, of the form:
 (defun pcase--split-pred (upat pat)
   ;; FIXME: For predicates like (pred (> a)), two such predicates may
   ;; actually refer to different variables `a'.
-  (cond
-   ((equal upat pat) (cons :pcase--succeed :pcase--fail))
-   ((and (eq 'pred (car upat))
-         (eq 'pred (car-safe pat))
-         (or (member (cons (cadr upat) (cadr pat))
-                     pcase-mutually-exclusive-predicates)
-             (member (cons (cadr pat) (cadr upat))
-                     pcase-mutually-exclusive-predicates)))
-    (cons :pcase--fail nil))
-   ;; ((and (eq 'pred (car upat))
-   ;;       (eq '\` (car-safe pat))
-   ;;       (symbolp (cadr upat))
-   ;;       (or (symbolp (cadr pat)) (stringp (cadr pat)) (numberp (cadr pat)))
-   ;;       (get (cadr upat) 'side-effect-free)
-   ;;       (progn (message "Trying predicate %S" (cadr upat))
-   ;;              (ignore-errors
-   ;;                (funcall (cadr upat) (cadr pat)))))
-   ;;  (message "Simplify pred %S against %S" upat pat)
-   ;;  (cons nil :pcase--fail))
-   ))
+  (let (test)
+    (cond
+     ((equal upat pat) (cons :pcase--succeed :pcase--fail))
+     ((and (eq 'pred (car upat))
+           (eq 'pred (car-safe pat))
+           (or (member (cons (cadr upat) (cadr pat))
+                       pcase-mutually-exclusive-predicates)
+               (member (cons (cadr pat) (cadr upat))
+                       pcase-mutually-exclusive-predicates)))
+      (cons :pcase--fail nil))
+     ((and (eq 'pred (car upat))
+           (eq '\` (car-safe pat))
+           (symbolp (cadr upat))
+           (or (symbolp (cadr pat)) (stringp (cadr pat)) (numberp (cadr pat)))
+           (get (cadr upat) 'side-effect-free)
+           (ignore-errors
+             (setq test (list (funcall (cadr upat) (cadr pat))))))
+      (if (car test)
+          (cons nil :pcase--fail)
+        (cons :pcase--fail nil))))))
 
 (defun pcase--fgrep (vars sexp)
   "Check which of the symbols VARS appear in SEXP."
@@ -463,6 +514,13 @@ MATCH is the pattern that needs to be matched, of the form:
     (and (memq sexp vars) (not (memq sexp res)) (push sexp res))
     res))
 
+(defun pcase--self-quoting-p (upat)
+  (or (keywordp upat) (numberp upat) (stringp upat)))
+
+(defsubst pcase--mark-used (sym)
+  ;; Exceptionally, `sym' may be a constant expression rather than a symbol.
+  (if (symbolp sym) (put sym 'pcase-used t)))
+
 ;; It's very tempting to use `pcase' below, tho obviously, it'd create
 ;; bootstrapping problems.
 (defun pcase--u1 (matches code vars rest)
@@ -525,12 +583,12 @@ Otherwise, it defers to REST which is a list of branches of the form
            (upat (cdr cdrpopmatches)))
       (cond
        ((memq upat '(t _)) (pcase--u1 matches code vars rest))
-       ((eq upat 'dontcare) :pcase--dontcare)
+       ((eq upat 'pcase--dontcare) :pcase--dontcare)
        ((memq (car-safe upat) '(guard pred))
-        (if (eq (car upat) 'pred) (put sym 'pcase-used t))
+        (if (eq (car upat) 'pred) (pcase--mark-used sym))
         (let* ((splitrest
                 (pcase--split-rest
-                 sym (apply-partially #'pcase--split-pred upat) rest))
+                 sym (lambda (pat) (pcase--split-pred upat pat)) rest))
                (then-rest (car splitrest))
                (else-rest (cdr splitrest)))
           (pcase--if (if (and (eq (car upat) 'pred) (symbolp (cadr upat)))
@@ -548,7 +606,8 @@ Otherwise, it defers to REST which is a list of branches of the form
                                         (let ((newsym (make-symbol "x")))
                                           (push (list newsym sym) env)
                                           (setq sym newsym)))
-                                      (if (functionp exp) `(,exp ,sym)
+                                      (if (functionp exp)
+                                          `(funcall #',exp ,sym)
                                         `(,@exp ,sym)))))
                          (if (null vs)
                              call
@@ -558,8 +617,11 @@ Otherwise, it defers to REST which is a list of branches of the form
                            `(let* ,env ,call))))
                      (pcase--u1 matches code vars then-rest)
                      (pcase--u else-rest))))
+       ((pcase--self-quoting-p upat)
+        (pcase--mark-used sym)
+        (pcase--q1 sym upat matches code vars rest))
        ((symbolp upat)
-        (put sym 'pcase-used t)
+        (pcase--mark-used sym)
         (if (not (assq upat vars))
             (pcase--u1 matches code (cons (cons upat sym) vars) rest)
           ;; Non-linear pattern.  Turn it into an `eq' test.
@@ -570,42 +632,41 @@ Otherwise, it defers to REST which is a list of branches of the form
         ;; A upat of the form (let VAR EXP).
         ;; (pcase--u1 matches code
         ;;            (cons (cons (nth 1 upat) (nth 2 upat)) vars) rest)
-        (let* ((exp
-                (let* ((exp (nth 2 upat))
-                       (found (assq exp vars)))
-                  (if found (cdr found)
-                    (let* ((vs (pcase--fgrep (mapcar #'car vars) exp))
-                           (env (mapcar (lambda (v) (list v (cdr (assq v vars))))
-                                        vs)))
-                      (if env `(let* ,env ,exp) exp)))))
-               (sym (if (symbolp exp) exp (make-symbol "x")))
-               (body
-                (pcase--u1 (cons `(match ,sym . ,(nth 1 upat)) matches)
-                           code vars rest)))
-          (if (eq sym exp)
-              body
-            `(let* ((,sym ,exp)) ,body))))
+        (macroexp-let2
+            macroexp-copyable-p sym
+            (let* ((exp (nth 2 upat))
+                   (found (assq exp vars)))
+              (if found (cdr found)
+                (let* ((vs (pcase--fgrep (mapcar #'car vars) exp))
+                       (env (mapcar (lambda (v) (list v (cdr (assq v vars))))
+                                    vs)))
+                  (if env (macroexp-let* env exp) exp))))
+          (pcase--u1 (cons `(match ,sym . ,(nth 1 upat)) matches)
+                     code vars rest)))
        ((eq (car-safe upat) '\`)
-        (put sym 'pcase-used t)
+        (pcase--mark-used sym)
         (pcase--q1 sym (cadr upat) matches code vars rest))
        ((eq (car-safe upat) 'or)
         (let ((all (> (length (cdr upat)) 1))
               (memq-fine t))
           (when all
             (dolist (alt (cdr upat))
-              (unless (and (eq (car-safe alt) '\`)
-                           (or (symbolp (cadr alt)) (integerp (cadr alt))
-                               (setq memq-fine nil)
-                               (stringp (cadr alt))))
+              (unless (or (pcase--self-quoting-p alt)
+                          (and (eq (car-safe alt) '\`)
+                               (or (symbolp (cadr alt)) (integerp (cadr alt))
+                                   (setq memq-fine nil)
+                                   (stringp (cadr alt)))))
                 (setq all nil))))
           (if all
               ;; Use memq for (or `a `b `c `d) rather than a big tree.
-              (let* ((elems (mapcar 'cadr (cdr upat)))
+              (let* ((elems (mapcar (lambda (x) (if (consp x) (cadr x) x))
+                                    (cdr upat)))
                      (splitrest
                       (pcase--split-rest
-                       sym (apply-partially #'pcase--split-member elems) rest))
+                       sym (lambda (pat) (pcase--split-member elems pat)) rest))
                      (then-rest (car splitrest))
                      (else-rest (cdr splitrest)))
+                (pcase--mark-used sym)
                 (pcase--if `(,(if memq-fine #'memq #'member) ,sym ',elems)
                            (pcase--u1 matches code vars then-rest)
                            (pcase--u else-rest)))
@@ -659,7 +720,7 @@ Otherwise, it defers to REST which is a list of branches of the form
            (symd (make-symbol "xcdr"))
            (splitrest (pcase--split-rest
                        sym
-                       (apply-partially #'pcase--split-consp syma symd)
+                       (lambda (pat) (pcase--split-consp syma symd pat))
                        rest))
            (then-rest (car splitrest))
            (else-rest (cdr splitrest))
@@ -673,19 +734,25 @@ Otherwise, it defers to REST which is a list of branches of the form
        ;; The byte-compiler could do that for us, but it would have to pay
        ;; attention to the `consp' test in order to figure out that car/cdr
        ;; can't signal errors and our byte-compiler is not that clever.
-       `(let (,@(if (get syma 'pcase-used) `((,syma (car ,sym))))
+       ;; FIXME: Some of those let bindings occur too early (they are used in
+       ;; `then-body', but only within some sub-branch).
+       (macroexp-let*
+        `(,@(if (get syma 'pcase-used) `((,syma (car ,sym))))
               ,@(if (get symd 'pcase-used) `((,symd (cdr ,sym)))))
-          ,then-body)
+        then-body)
        (pcase--u else-rest))))
    ((or (integerp qpat) (symbolp qpat) (stringp qpat))
       (let* ((splitrest (pcase--split-rest
-                         sym (apply-partially 'pcase--split-equal qpat) rest))
+                         sym (lambda (pat) (pcase--split-equal qpat pat)) rest))
              (then-rest (car splitrest))
              (else-rest (cdr splitrest)))
-      (pcase--if `(,(if (stringp qpat) #'equal #'eq) ,sym ',qpat)
+      (pcase--if (cond
+                  ((stringp qpat) `(equal ,sym ,qpat))
+                  ((null qpat) `(null ,sym))
+                  (t `(eq ,sym ',qpat)))
                  (pcase--u1 matches code vars then-rest)
                  (pcase--u else-rest))))
-   (t (error "Unkown QPattern %s" qpat))))
+   (t (error "Unknown QPattern %s" qpat))))
 
 
 (provide 'pcase)
diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el
index 2d1b8860a3c..30c16b51b9e 100644
--- a/lisp/emacs-lisp/pp.el
+++ b/lisp/emacs-lisp/pp.el
@@ -1,6 +1,6 @@
 ;;; pp.el --- pretty printer for Emacs Lisp
 
-;; Copyright (C) 1989, 1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 1993, 2001-2012 Free Software Foundation, Inc.
 
 ;; Author: Randal Schwartz <merlyn@stonehenge.com>
 ;; Keywords: lisp
@@ -41,17 +41,14 @@
   "Return a string containing the pretty-printed representation of OBJECT.
 OBJECT can be any Lisp object.  Quoting characters are used as needed
 to make output that `read' can handle, whenever this is possible."
-  (with-current-buffer (generate-new-buffer " pp-to-string")
-    (unwind-protect
-	(progn
-	  (lisp-mode-variables nil)
-	  (set-syntax-table emacs-lisp-mode-syntax-table)
-	  (let ((print-escape-newlines pp-escape-newlines)
-		(print-quoted t))
-	    (prin1 object (current-buffer)))
-          (pp-buffer)
-	  (buffer-string))
-      (kill-buffer (current-buffer)))))
+  (with-temp-buffer
+    (lisp-mode-variables nil)
+    (set-syntax-table emacs-lisp-mode-syntax-table)
+    (let ((print-escape-newlines pp-escape-newlines)
+          (print-quoted t))
+      (prin1 object (current-buffer)))
+    (pp-buffer)
+    (buffer-string)))
 
 ;;;###autoload
 (defun pp-buffer ()
@@ -60,9 +57,7 @@ to make output that `read' can handle, whenever this is possible."
   (while (not (eobp))
     ;; (message "%06d" (- (point-max) (point)))
     (cond
-     ((condition-case err-var
-          (prog1 t (down-list 1))
-        (error nil))
+     ((ignore-errors (down-list 1) t)
       (save-excursion
         (backward-char 1)
         (skip-chars-backward "'`#^")
@@ -71,10 +66,8 @@ to make output that `read' can handle, whenever this is possible."
            (point)
            (progn (skip-chars-backward " \t\n") (point)))
           (insert "\n"))))
-     ((condition-case err-var
-          (prog1 t (up-list 1))
-        (error nil))
-      (while (looking-at "\\s)")
+     ((ignore-errors (up-list 1) t)
+      (while (looking-at-p "\\s)")
         (forward-char 1))
       (delete-region
        (point)
@@ -117,7 +110,8 @@ after OUT-BUFFER-NAME."
 			 (progn
 			   (select-window window)
 			   (run-hooks 'temp-buffer-show-hook))
-		       (select-window old-selected)
+		       (when (window-live-p old-selected)
+			 (select-window old-selected))
 		       (message "See buffer %s." out-buffer-name)))
 		 (message "%s" (buffer-substring (point-min) (point)))
 		 ))))))
@@ -154,7 +148,7 @@ Also add the value to the front of the list in the variable `values'."
     (save-excursion
       (forward-sexp -1)
       ;; If first line is commented, ignore all leading comments:
-      (if (save-excursion (beginning-of-line) (looking-at "[ \t]*;"))
+      (if (save-excursion (beginning-of-line) (looking-at-p "[ \t]*;"))
 	  (progn
 	    (setq exp (buffer-substring (point) pt))
 	    (while (string-match "\n[ \t]*;+" exp start)
diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el
index ebbd6ff1fdf..05bb7577d22 100644
--- a/lisp/emacs-lisp/re-builder.el
+++ b/lisp/emacs-lisp/re-builder.el
@@ -1,6 +1,6 @@
 ;;; re-builder.el --- building Regexps with visual feedback -*- lexical-binding: t -*-
 
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
 
 ;; Author: Detlev Zundel <dzu@gnu.org>
 ;; Keywords: matching, lisp, tools
@@ -38,7 +38,7 @@
 ;; the target buffer are marked automatically with colored overlays
 ;; (for non-color displays see below) giving you feedback over the
 ;; extents of the matched (sub) expressions.  The (non-)validity is
-;; shown only in the modeline without throwing the errors at you.  If
+;; shown only in the mode line without throwing the errors at you.  If
 ;; you want to know the reason why RE Builder considers it as invalid
 ;; call `reb-force-update' ("\C-c\C-u") which should reveal the error.
 
diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el
index b538a7a2943..8c64327c0ff 100644
--- a/lisp/emacs-lisp/regexp-opt.el
+++ b/lisp/emacs-lisp/regexp-opt.el
@@ -1,6 +1,6 @@
 ;;; regexp-opt.el --- generate efficient regexps to match strings
 
-;; Copyright (C) 1994-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2012 Free Software Foundation, Inc.
 
 ;; Author: Simon Marshall <simon@gnu.org>
 ;; Maintainer: FSF
@@ -136,14 +136,11 @@ This means the number of non-shy regexp grouping constructs
 
 ;;; Workhorse functions.
 
-(eval-when-compile
-  (require 'cl))
-
 (defun regexp-opt-group (strings &optional paren lax)
   "Return a regexp to match a string in the sorted list STRINGS.
 If PAREN non-nil, output regexp parentheses around returned regexp.
 If LAX non-nil, don't output parentheses if it doesn't require them.
-Merges keywords to avoid backtracking in Emacs' regexp matcher."
+Merges keywords to avoid backtracking in Emacs's regexp matcher."
   ;; The basic idea is to find the shortest common prefix or suffix, remove it
   ;; and recurse.  If there is no prefix, we divide the list into two so that
   ;; \(at least) one half will have at least a one-character common prefix.
@@ -237,7 +234,8 @@ Merges keywords to avoid backtracking in Emacs' regexp matcher."
 
 
 (defun regexp-opt-charset (chars)
-  "Return a regexp to match a character in CHARS."
+  "Return a regexp to match a character in CHARS.
+CHARS should be a list of characters."
   ;; The basic idea is to find character ranges.  Also we take care in the
   ;; position of character set meta characters in the character set regexp.
   ;;
@@ -248,15 +246,15 @@ Merges keywords to avoid backtracking in Emacs' regexp matcher."
     ;;
     ;; Make a character map but extract character set meta characters.
     (dolist (char chars)
-      (case char
-	(?\]
-	 (setq bracket "]"))
-	(?^
-	 (setq caret "^"))
-	(?-
-	 (setq dash "-"))
-	(otherwise
-	 (aset charmap char t))))
+      (cond
+       ((eq char ?\])
+	(setq bracket "]"))
+       ((eq char ?^)
+	(setq caret "^"))
+       ((eq char ?-)
+	(setq dash "-"))
+       (t
+	(aset charmap char t))))
     ;;
     ;; Make a character set from the map using ranges where applicable.
     (map-char-table
@@ -268,14 +266,14 @@ Merges keywords to avoid backtracking in Emacs' regexp matcher."
 		   (setq charset (format "%s%c-%c" charset start end))
 		 (while (>= end start)
 		   (setq charset (format "%s%c" charset start))
-		   (incf start)))
+		   (setq start (1+ start))))
 	       (setq start (car c) end (cdr c)))
 	   (if (= (1- c) end) (setq end c)
 	     (if (> end (+ start 2))
 	       (setq charset (format "%s%c-%c" charset start end))
 	     (while (>= end start)
 	       (setq charset (format "%s%c" charset start))
-	       (incf start)))
+	       (setq start (1+ start))))
 	     (setq start c end c)))))
      charmap)
     (when (>= end start)
@@ -283,7 +281,7 @@ Merges keywords to avoid backtracking in Emacs' regexp matcher."
 	  (setq charset (format "%s%c-%c" charset start end))
 	(while (>= end start)
 	  (setq charset (format "%s%c" charset start))
-	  (incf start))))
+	  (setq start (1+ start)))))
     ;;
     ;; Make sure a caret is not first and a dash is first or last.
     (if (and (string-equal charset "") (string-equal bracket ""))
diff --git a/lisp/emacs-lisp/regi.el b/lisp/emacs-lisp/regi.el
index 6905589e5be..a68c67246ff 100644
--- a/lisp/emacs-lisp/regi.el
+++ b/lisp/emacs-lisp/regi.el
@@ -1,6 +1,6 @@
 ;;; regi.el --- REGular expression Interpreting engine
 
-;; Copyright (C) 1993, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc.
 
 ;; Author: 1993 Barry A. Warsaw, Century Computing, Inc. <bwarsaw@cen.com>
 ;; Maintainer:    bwarsaw@cen.com
diff --git a/lisp/emacs-lisp/ring.el b/lisp/emacs-lisp/ring.el
index affaa9ce32e..cee6a43df86 100644
--- a/lisp/emacs-lisp/ring.el
+++ b/lisp/emacs-lisp/ring.el
@@ -1,6 +1,6 @@
 ;;; ring.el --- handle rings of items
 
-;; Copyright (C) 1992, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2012 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: extensions
@@ -185,26 +185,31 @@ Raise error if ITEM is not in the RING."
     (unless curr-index (error "Item is not in the ring: `%s'" item))
     (ring-ref ring (ring-minus1 curr-index (ring-length ring)))))
 
+(defun ring-extend (ring x)
+  "Increase the size of RING by X."
+  (when (and (integerp x) (> x 0))
+    (let* ((hd       (car ring))
+	   (length   (ring-length ring))
+	   (size     (ring-size ring))
+	   (old-vec  (cddr ring))
+	   (new-vec  (make-vector (+ size x) nil)))
+      (setcdr ring (cons length new-vec))
+      ;; If the ring is wrapped, the existing elements must be written
+      ;; out in the right order.
+      (dotimes (j length)
+	(aset new-vec j (aref old-vec (mod (+ hd j) size))))
+      (setcar ring 0))))
+
 (defun ring-insert+extend (ring item &optional grow-p)
   "Like `ring-insert', but if GROW-P is non-nil, then enlarge ring.
 Insert onto ring RING the item ITEM, as the newest (last) item.
 If the ring is full, behavior depends on GROW-P:
   If GROW-P is non-nil, enlarge the ring to accommodate the new item.
   If GROW-P is nil, dump the oldest item to make room for the new."
-  (let* ((vec (cddr ring))
-	 (veclen (length vec))
-	 (hd (car ring))
-	 (ringlen (ring-length ring)))
-    (prog1
-        (cond ((and grow-p (= ringlen veclen)) ; Full ring.  Enlarge it.
-               (setq veclen (1+ veclen))
-               (setcdr ring (cons (setq ringlen (1+ ringlen))
-                                  (setq vec (vconcat vec (vector item)))))
-               (setcar ring hd))
-              (t (aset vec (mod (+ hd ringlen) veclen) item)))
-      (if (= ringlen veclen)
-          (setcar ring (ring-plus1 hd veclen))
-        (setcar (cdr ring) (1+ ringlen))))))
+  (and grow-p
+       (= (ring-length ring) (ring-size ring))
+       (ring-extend ring 1))
+  (ring-insert ring item))
 
 (defun ring-remove+insert+extend (ring item &optional grow-p)
   "`ring-remove' ITEM from RING, then `ring-insert+extend' it.
diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el
index 2e388d20114..774c6cd2c38 100644
--- a/lisp/emacs-lisp/rx.el
+++ b/lisp/emacs-lisp/rx.el
@@ -1,6 +1,6 @@
 ;;; rx.el --- sexp notation for regular expressions
 
-;; Copyright (C) 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2012 Free Software Foundation, Inc.
 
 ;; Author: Gerd Moellmann <gerd@gnu.org>
 ;; Maintainer: FSF
@@ -35,9 +35,8 @@
 ;; that the `repeat' form can't have multiple regexp args.
 
 ;; Now alternative forms are provided for a degree of compatibility
-;; with Shivers' attempted definitive SRE notation
-;; <URL:http://www.ai.mit.edu/~/shivers/sre.txt>.  SRE forms not
-;; catered for include: dsm, uncase, w/case, w/nocase, ,@<exp>,
+;; with Olin Shivers' attempted definitive SRE notation.  SRE forms
+;; not catered for include: dsm, uncase, w/case, w/nocase, ,@<exp>,
 ;; ,<exp>, (word ...), word+, posix-string, and character class forms.
 ;; Some forms are inconsistent with SRE, either for historical reasons
 ;; or because of the implementation -- simple translation into Emacs
@@ -108,7 +107,9 @@
 
 ;;; Code:
 
-(defconst rx-constituents
+;; FIXME: support macros.
+
+(defvar rx-constituents              ;Not `const' because some modes extend it.
   '((and		. (rx-and 1 nil))
     (seq		. and)		; SRE
     (:			. and)		; SRE
@@ -832,27 +833,28 @@ If FORM is '(minimal-match FORM1)', non-greedy versions of `*',
 FORM is a regular expression in sexp form.
 RX-PARENT shows which type of expression calls and controls putting of
 shy groups around the result and some more in other functions."
-  (if (stringp form)
-      (rx-group-if (regexp-quote form)
-		   (if (and (eq rx-parent '*) (< 1 (length form)))
-		       rx-parent))
-    (cond ((integerp form)
-	   (regexp-quote (char-to-string form)))
-	  ((symbolp form)
-	   (let ((info (rx-info form nil)))
-	     (cond ((stringp info)
-		    info)
-		   ((null info)
-		    (error "Unknown rx form `%s'" form))
-		   (t
-		    (funcall (nth 0 info) form)))))
-	  ((consp form)
-	   (let ((info (rx-info (car form) 'head)))
-	     (unless (consp info)
-	       (error "Unknown rx form `%s'" (car form)))
-	     (funcall (nth 0 info) form)))
-	  (t
-	   (error "rx syntax error at `%s'" form)))))
+  (cond
+   ((stringp form)
+    (rx-group-if (regexp-quote form)
+                 (if (and (eq rx-parent '*) (< 1 (length form)))
+                     rx-parent)))
+   ((integerp form)
+    (regexp-quote (char-to-string form)))
+   ((symbolp form)
+    (let ((info (rx-info form nil)))
+      (cond ((stringp info)
+             info)
+            ((null info)
+             (error "Unknown rx form `%s'" form))
+            (t
+             (funcall (nth 0 info) form)))))
+   ((consp form)
+    (let ((info (rx-info (car form) 'head)))
+      (unless (consp info)
+        (error "Unknown rx form `%s'" (car form)))
+      (funcall (nth 0 info) form)))
+   (t
+    (error "rx syntax error at `%s'" form))))
 
 
 ;;;###autoload
diff --git a/lisp/emacs-lisp/shadow.el b/lisp/emacs-lisp/shadow.el
index d5bba20b1cd..bceec296ad8 100644
--- a/lisp/emacs-lisp/shadow.el
+++ b/lisp/emacs-lisp/shadow.el
@@ -1,6 +1,6 @@
 ;;; shadow.el --- locate Emacs Lisp file shadowings
 
-;; Copyright (C) 1995, 2001-2011  Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2012  Free Software Foundation, Inc.
 
 ;; Author: Terry Jones <terry@santafe.edu>
 ;; Keywords: lisp
@@ -158,8 +158,14 @@ See the documentation for `list-load-path-shadows' for further information."
 		      (eq 0 (call-process "cmp" nil nil nil "-s" f1 f2))))))))
 
 (defvar load-path-shadows-font-lock-keywords
+  ;; The idea is that shadows of files supplied with Emacs are more
+  ;; serious than various versions of external packages shadowing each
+  ;; other.
   `((,(format "hides \\(%s.*\\)"
-	      (file-name-directory (locate-library "simple.el")))
+	      (file-name-directory
+	       (or (locate-library "simple")
+		   (file-name-as-directory
+		    (expand-file-name "../lisp" data-directory)))))
      . (1 font-lock-warning-face)))
   "Keywords to highlight in `load-path-shadows-mode'.")
 
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index afc8c7faa47..9fa8a108236 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -1,6 +1,6 @@
 ;;; smie.el --- Simple Minded Indentation Engine -*- lexical-binding: t -*-
 
-;; Copyright (C) 2010-2011  Free Software Foundation, Inc.
+;; Copyright (C) 2010-2012  Free Software Foundation, Inc.
 
 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
 ;; Keywords: languages, lisp, internal, parsing, indentation
@@ -56,7 +56,7 @@
 ;; building the 2D precedence tables and then computing the precedence levels
 ;; from it) can be found in pages 187-194 of "Parsing techniques" by Dick Grune
 ;; and Ceriel Jacobs (BookBody.pdf available at
-;; http://www.cs.vu.nl/~dick/PTAPG.html).
+;; http://dickgrune.com/Books/PTAPG_1st_Edition/).
 ;;
 ;; OTOH we had to kill many chickens, read many coffee grounds, and practice
 ;; untold numbers of black magic spells, to come up with the indentation code.
@@ -121,7 +121,7 @@
 ;; - smie-indent-comment doesn't interact well with mis-indented lines (where
 ;;   the indent rules don't do what the user wants).  Not sure what to do.
 
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
 
 (defgroup smie nil
   "Simple Minded Indentation Engine."
@@ -155,7 +155,7 @@
 (defvar smie-warning-count 0)
 
 (defun smie-set-prec2tab (table x y val &optional override)
-  (assert (and x y))
+  (cl-assert (and x y))
   (let* ((key (cons x y))
          (old (gethash key table)))
     (if (and old (not (eq old val)))
@@ -166,7 +166,7 @@
             ;; don't hide real conflicts.
             (puthash key (gethash key override) table)
           (display-warning 'smie (format "Conflict: %s %s/%s %s" x old val y))
-          (incf smie-warning-count))
+          (cl-incf smie-warning-count))
       (puthash key val table))))
 
 (put 'smie-precs->prec2 'pure t)
@@ -268,8 +268,8 @@ be either:
           (unless (consp rhs)
             (signal 'wrong-type-argument `(consp ,rhs)))
           (if (not (member (car rhs) nts))
-              (pushnew (car rhs) first-ops)
-            (pushnew (car rhs) first-nts)
+              (cl-pushnew (car rhs) first-ops)
+            (cl-pushnew (car rhs) first-nts)
             (when (consp (cdr rhs))
               ;; If the first is not an OP we add the second (which
               ;; should be an OP if BNF is an "operator grammar").
@@ -282,16 +282,16 @@ be either:
               (when (member (cadr rhs) nts)
                 (error "Adjacent non-terminals: %s %s"
                        (car rhs) (cadr rhs)))
-              (pushnew (cadr rhs) first-ops)))
+              (cl-pushnew (cadr rhs) first-ops)))
           (let ((shr (reverse rhs)))
             (if (not (member (car shr) nts))
-                (pushnew (car shr) last-ops)
-              (pushnew (car shr) last-nts)
+                (cl-pushnew (car shr) last-ops)
+              (cl-pushnew (car shr) last-nts)
               (when (consp (cdr shr))
                 (when (member (cadr shr) nts)
                   (error "Adjacent non-terminals: %s %s"
                          (cadr shr) (car shr)))
-                (pushnew (cadr shr) last-ops)))))
+                (cl-pushnew (cadr shr) last-ops)))))
         (push (cons nt first-ops) first-ops-table)
         (push (cons nt last-ops) last-ops-table)
         (push (cons nt first-nts) first-nts-table)
@@ -416,12 +416,12 @@ from the table, e.g. the table will not include things like (\"if\" . \"else\").
           (if no-inners
               (let ((last (car (last rhs))))
                 (unless (member last nts)
-                  (pushnew (cons (car rhs) last) alist :test #'equal)))
+                  (cl-pushnew (cons (car rhs) last) alist :test #'equal)))
             ;; Reverse so that the "real" closer gets there first,
             ;; which is important for smie-close-block.
             (dolist (term (reverse (cdr rhs)))
               (unless (member term nts)
-                (pushnew (cons (car rhs) term) alist :test #'equal)))))))
+                (cl-pushnew (cons (car rhs) term) alist :test #'equal)))))))
     (nreverse alist)))
 
 (defun smie-bnf--set-class (table token class)
@@ -483,7 +483,7 @@ CSTS is a list of pairs representing arcs in a graph."
                            (push (concat "." (car elem)) res))
                        (if (eq (cddr elem) val)
                            (push (concat (car elem) ".") res)))
-                     (assert res)
+                     (cl-assert res)
                      res))
                  cycle)))
     (mapconcat
@@ -498,9 +498,9 @@ CSTS is a list of pairs representing arcs in a graph."
 ;;                      (right (nth 1 (assoc (cdr k) grammar))))
 ;;                  (when (and left right)
 ;;                    (cond
-;;                     ((< left right) (assert (eq v '<)))
-;;                     ((> left right) (assert (eq v '>)))
-;;                     (t (assert (eq v '=))))))))
+;;                     ((< left right) (cl-assert (eq v '<)))
+;;                     ((> left right) (cl-assert (eq v '>)))
+;;                     (t (cl-assert (eq v '=))))))))
 ;;            prec2))
 
 (put 'smie-prec2->grammar 'pure t)
@@ -514,25 +514,28 @@ PREC2 is a table as returned by `smie-precs->prec2' or
   ;; final `table'.  The value of each "variable" is kept in the `car'.
   (let ((table ())
         (csts ())
-        (eqs ())
-        tmp x y)
+        (eqs ()))
     ;; From `prec2' we construct a list of constraints between
     ;; variables (aka "precedence levels").  These can be either
     ;; equality constraints (in `eqs') or `<' constraints (in `csts').
     (maphash (lambda (k v)
                (when (consp k)
-                 (if (setq tmp (assoc (car k) table))
-                     (setq x (cddr tmp))
-                   (setq x (cons nil nil))
-                   (push (cons (car k) (cons nil x)) table))
-                 (if (setq tmp (assoc (cdr k) table))
-                     (setq y (cdr tmp))
-                   (setq y (cons nil (cons nil nil)))
-                   (push (cons (cdr k) y) table))
-                 (ecase v
-                   (= (push (cons x y) eqs))
-                   (< (push (cons x y) csts))
-                   (> (push (cons y x) csts)))))
+                 (let ((tmp (assoc (car k) table))
+                       x y)
+                   (if tmp
+                       (setq x (cddr tmp))
+                     (setq x (cons nil nil))
+                     (push (cons (car k) (cons nil x)) table))
+                   (if (setq tmp (assoc (cdr k) table))
+                       (setq y (cdr tmp))
+                     (setq y (cons nil (cons nil nil)))
+                     (push (cons (cdr k) y) table))
+                   (pcase v
+                     (`= (push (cons x y) eqs))
+                     (`< (push (cons x y) csts))
+                     (`> (push (cons y x) csts))
+                     (_ (error "SMIE error: prec2 has %S↦%S which ∉ {<,+,>}"
+                               k v))))))
              prec2)
     ;; First process the equality constraints.
     (let ((eqs eqs))
@@ -572,13 +575,13 @@ PREC2 is a table as returned by `smie-precs->prec2' or
               (unless (caar cst)
                 (setcar (car cst) i)
                 ;; (smie-check-grammar table prec2 'step1)
-                (incf i))
+                (cl-incf i))
               (setq csts (delq cst csts))))
           (unless progress
             (error "Can't resolve the precedence cycle: %s"
                    (smie-debug--describe-cycle
                     table (smie-debug--prec2-cycle csts)))))
-        (incf i 10))
+        (cl-incf i 10))
       ;; Propagate equality constraints back to their sources.
       (dolist (eq (nreverse eqs))
         (when (null (cadr eq))
@@ -589,8 +592,8 @@ PREC2 is a table as returned by `smie-precs->prec2' or
           ;; So set it here rather than below since doing it below
           ;; makes it more difficult to obey the equality constraints.
           (setcar (cdr eq) i)
-          (incf i))
-        (assert (or (null (caar eq)) (eq (caar eq) (cadr eq))))
+          (cl-incf i))
+        (cl-assert (or (null (caar eq)) (eq (caar eq) (cadr eq))))
         (setcar (car eq) (cadr eq))
         ;; (smie-check-grammar table prec2 'step2)
         )
@@ -599,17 +602,17 @@ PREC2 is a table as returned by `smie-precs->prec2' or
       (dolist (x table)
         (unless (nth 1 x)
           (setf (nth 1 x) i)
-          (incf i))                     ;See other (incf i) above.
+          (cl-incf i))                  ;See other (cl-incf i) above.
         (unless (nth 2 x)
           (setf (nth 2 x) i)
-          (incf i))))                   ;See other (incf i) above.
+          (cl-incf i))))                ;See other (cl-incf i) above.
     ;; Mark closers and openers.
     (dolist (x (gethash :smie-open/close-alist prec2))
       (let* ((token (car x))
-             (cons (case (cdr x)
-                     (closer (cddr (assoc token table)))
-                     (opener (cdr (assoc token table))))))
-        (assert (numberp (car cons)))
+             (cons (pcase (cdr x)
+                     (`closer (cddr (assoc token table)))
+                     (`opener (cdr (assoc token table))))))
+        (cl-assert (numberp (car cons)))
         (setf (car cons) (list (car cons)))))
     (let ((ca (gethash :smie-closer-alist prec2)))
       (when ca (push (cons :smie-closer-alist ca) table)))
@@ -688,6 +691,7 @@ Possible return values:
     is too high.  FORW-LEVEL is the forw-level of TOKEN,
     POS is its start position in the buffer.
   (t POS TOKEN): same thing when we bump on the wrong side of a paren.
+    Instead of t, the `car' can also be some other non-nil non-number value.
   (nil POS TOKEN): we skipped over a paren-like pair.
   nil: we skipped over an identifier, matched parentheses, ..."
   (catch 'return
@@ -704,20 +708,19 @@ Possible return values:
               (when (zerop (length token))
                 (condition-case err
                     (progn (goto-char pos) (funcall next-sexp 1) nil)
-                  (scan-error (throw 'return
-                                     (list t (caddr err)
-                                           (buffer-substring-no-properties
-                                            (caddr err)
-                                            (+ (caddr err)
-                                               (if (< (point) (caddr err))
-                                                   -1 1)))))))
+                  (scan-error
+                   (let ((pos (nth 2 err)))
+                     (throw 'return
+                            (list t pos
+                                  (buffer-substring-no-properties
+                                   pos (+ pos (if (< (point) pos) -1 1))))))))
                 (if (eq pos (point))
                     ;; We did not move, so let's abort the loop.
                     (throw 'return (list t (point))))))
              ((not (numberp (funcall op-back toklevels)))
               ;; A token like a paren-close.
-              (assert (numberp     ; Otherwise, why mention it in smie-grammar.
-                       (funcall op-forw toklevels)))
+              (cl-assert (numberp  ; Otherwise, why mention it in smie-grammar.
+                          (funcall op-forw toklevels)))
               (push toklevels levels))
              (t
               (while (and levels (< (funcall op-back toklevels)
@@ -728,7 +731,8 @@ Possible return values:
                 (if (and halfsexp (numberp (funcall op-forw toklevels)))
                     (push toklevels levels)
                   (throw 'return
-                         (prog1 (list (or (car toklevels) t) (point) token)
+                         (prog1 (list (or (funcall op-forw toklevels) t)
+                                      (point) token)
                            (goto-char pos)))))
                (t
                 (let ((lastlevels levels))
@@ -773,7 +777,8 @@ Possible return values:
                    ((and lastlevels
                          (smie--associative-p (car lastlevels)))
                     (throw 'return
-                           (prog1 (list (or (car toklevels) t) (point) token)
+                           (prog1 (list (or (funcall op-forw toklevels) t)
+                                        (point) token)
                              (goto-char pos))))
                    ;; - it's an associative operator within a larger construct
                    ;;   (e.g. an "elsif"), so we should just ignore it and keep
@@ -793,6 +798,7 @@ Possible return values:
     is too high.  LEFT-LEVEL is the left-level of TOKEN,
     POS is its start position in the buffer.
   (t POS TOKEN): same thing but for an open-paren or the beginning of buffer.
+    Instead of t, the `car' can also be some other non-nil non-number value.
   (nil POS TOKEN): we skipped over a paren-like pair.
   nil: we skipped over an identifier, matched parentheses, ..."
   (smie-next-sexp
@@ -812,7 +818,8 @@ Possible return values:
   (RIGHT-LEVEL POS TOKEN): we couldn't skip TOKEN because its left-level
     is too high.  RIGHT-LEVEL is the right-level of TOKEN,
     POS is its end position in the buffer.
-  (t POS TOKEN): same thing but for an open-paren or the beginning of buffer.
+  (t POS TOKEN): same thing but for a close-paren or the end of buffer.
+    Instead of t, the `car' can also be some other non-nil non-number value.
   (nil POS TOKEN): we skipped over a paren-like pair.
   nil: we skipped over an identifier, matched parentheses, ..."
   (smie-next-sexp
@@ -1074,6 +1081,16 @@ the beginning of a line."
   "Return non-nil if the current token is the first on the line."
   (save-excursion (skip-chars-backward " \t") (bolp)))
 
+(defun smie-indent--bolp-1 ()
+  ;; Like smie-indent--bolp but also returns non-nil if it's the first
+  ;; non-comment token.  Maybe we should simply always use this?
+  "Return non-nil if the current token is the first on the line.
+Comments are treated as spaces."
+  (let ((bol (line-beginning-position)))
+    (save-excursion
+      (forward-comment (- (point)))
+      (<= (point) bol))))
+
 ;; Dynamically scoped.
 (defvar smie--parent) (defvar smie--after) (defvar smie--token)
 
@@ -1350,9 +1367,12 @@ should not be computed on the basis of the following token."
         ;; - middle-of-line: "trust current position".
         (cond
          ((smie-indent--rule :before token))
-         ((smie-indent--bolp)           ;I.e. non-virtual indent.
+         ((smie-indent--bolp-1)         ;I.e. non-virtual indent.
           ;; For an open-paren-like thingy at BOL, always indent only
           ;; based on other rules (typically smie-indent-after-keyword).
+          ;; FIXME: we do the same if after a comment, since we may be trying
+          ;; to compute the indentation of this comment and we shouldn't indent
+          ;; based on the indentation of subsequent code.
           nil)
          (t
           ;; By default use point unless we're hanging.
@@ -1453,6 +1473,12 @@ should not be computed on the basis of the following token."
        (save-excursion
          (forward-comment (point-max))
          (skip-chars-forward " \t\r\n")
+         ;; FIXME: We assume here that smie-indent-calculate will compute the
+         ;; indentation of the next token based on text before the comment, but
+         ;; this is not guaranteed, so maybe we should let
+         ;; smie-indent-calculate return some info about which buffer position
+         ;; was used as the "indentation base" and check that this base is
+         ;; before `pos'.
          (smie-indent-calculate))))
 
 (defun smie-indent-comment-continue ()
@@ -1602,6 +1628,36 @@ to which that point should be aligned, if we were to reindent it.")
           (save-excursion (indent-line-to indent))
         (indent-line-to indent)))))
 
+(defun smie-auto-fill ()
+  (let ((fc (current-fill-column)))
+    (while (and fc (> (current-column) fc))
+      (cond
+       ((not (or (nth 8 (save-excursion
+                          (syntax-ppss (line-beginning-position))))
+                 (nth 8 (syntax-ppss))))
+        (save-excursion
+          (beginning-of-line)
+          (smie-indent-forward-token)
+          (let ((bsf (point))
+                (gain 0)
+                curcol)
+            (while (<= (setq curcol (current-column)) fc)
+              ;; FIXME?  `smie-indent-calculate' can (and often will)
+              ;; return a result that actually depends on the presence/absence
+              ;; of a newline, so the gain computed here may not be accurate,
+              ;; but in practice it seems to works well enough.
+              (let* ((newcol (smie-indent-calculate))
+                     (newgain (- curcol newcol)))
+                (when (> newgain gain)
+                  (setq gain newgain)
+                  (setq bsf (point))))
+              (smie-indent-forward-token))
+            (when (> gain 0)
+              (goto-char bsf)
+              (newline-and-indent)))))
+       (t (do-auto-fill))))))
+
+
 (defun smie-setup (grammar rules-function &rest keywords)
   "Setup SMIE navigation and indentation.
 GRAMMAR is a grammar table generated by `smie-prec2->grammar'.
@@ -1612,17 +1668,18 @@ KEYWORDS are additional arguments, which can use the following keywords:
   (set (make-local-variable 'smie-rules-function) rules-function)
   (set (make-local-variable 'smie-grammar) grammar)
   (set (make-local-variable 'indent-line-function) 'smie-indent-line)
+  (set (make-local-variable 'normal-auto-fill-function) 'smie-auto-fill)
   (set (make-local-variable 'forward-sexp-function)
        'smie-forward-sexp-command)
   (while keywords
     (let ((k (pop keywords))
           (v (pop keywords)))
-      (case k
-        (:forward-token
+      (pcase k
+        (`:forward-token
          (set (make-local-variable 'smie-forward-token-function) v))
-        (:backward-token
+        (`:backward-token
          (set (make-local-variable 'smie-backward-token-function) v))
-        (t (message "smie-setup: ignoring unknown keyword %s" k)))))
+        (_ (message "smie-setup: ignoring unknown keyword %s" k)))))
   (let ((ca (cdr (assq :smie-closer-alist grammar))))
     (when ca
       (set (make-local-variable 'smie-closer-alist) ca)
diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el
index 85fa4772eb6..592cb1b0174 100644
--- a/lisp/emacs-lisp/syntax.el
+++ b/lisp/emacs-lisp/syntax.el
@@ -1,6 +1,6 @@
-;;; syntax.el --- helper functions to find syntactic context
+;;; syntax.el --- helper functions to find syntactic context  -*- lexical-binding: t -*-
 
-;; Copyright (C) 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2012 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: internal
@@ -41,7 +41,7 @@
 
 ;; Note: PPSS stands for `parse-partial-sexp state'
 
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
 
 (defvar font-lock-beginning-of-syntax-function)
 
@@ -55,12 +55,18 @@
   ;; have to flush that cache between each function, and we couldn't use
   ;; syntax-ppss-flush-cache since that would not only flush the cache but also
   ;; reset syntax-propertize--done which should not be done in this case).
-  "Mode-specific function to apply the syntax-table properties.
-Called with two arguments: START and END.
-This function can call `syntax-ppss' on any position before END, but it
-should not call `syntax-ppss-flush-cache', which means that it should not
-call `syntax-ppss' on some position and later modify the buffer on some
-earlier position.")
+  "Mode-specific function to apply `syntax-table' text properties.
+The value of this variable is a function to be called by Font
+Lock mode, prior to performing syntactic fontification on a
+stretch of text.  It is given two arguments, START and END: the
+start and end of the text to be fontified.  Major modes can
+specify a custom function to apply `syntax-table' properties to
+override the default syntax table in special cases.
+
+The specified function may call `syntax-ppss' on any position
+before END, but it should not call `syntax-ppss-flush-cache',
+which means that it should not call `syntax-ppss' on some
+position and later modify the buffer on some earlier position.")
 
 (defvar syntax-propertize-chunk-size 500)
 
@@ -118,7 +124,7 @@ The arg RULES can be of the same form as in `syntax-propertize-rules'.
 The return value is an object that can be passed as a rule to
 `syntax-propertize-rules'.
 I.e. this is useful only when you want to share rules among several
-syntax-propertize-functions."
+`syntax-propertize-function's."
   (declare (debug syntax-propertize-rules))
   ;; Precompile?  Yeah, right!
   ;; Seriously, tho, this is a macro for 2 reasons:
@@ -181,7 +187,7 @@ Note: back-references in REGEXPs do not work."
                  ;; If there's more than 1 rule, and the rule want to apply
                  ;; highlight to match 0, create an extra group to be able to
                  ;; tell when *this* match 0 has succeeded.
-                 (incf offset)
+                 (cl-incf offset)
                  (setq re (concat "\\(" re "\\)")))
                (setq re (syntax-propertize--shift-groups re offset))
                (let ((code '())
@@ -215,7 +221,7 @@ Note: back-references in REGEXPs do not work."
                      (setq offset 0)))
                  ;; Now construct the code for each subgroup rules.
                  (dolist (case (cdr rule))
-                   (assert (null (cddr case)))
+                   (cl-assert (null (cddr case)))
                    (let* ((gn (+ offset (car case)))
                           (action (nth 1 case))
                           (thiscode
@@ -260,7 +266,7 @@ Note: back-references in REGEXPs do not work."
                              code))))
                  (push (cons condition (nreverse code))
                        branches))
-               (incf offset (regexp-opt-depth orig-re))
+               (cl-incf offset (regexp-opt-depth orig-re))
                re))
            rules
            "\\|")))
@@ -274,13 +280,12 @@ Note: back-references in REGEXPs do not work."
   "Propertize for syntax in START..END using font-lock syntax.
 KEYWORDS obeys the format used in `font-lock-syntactic-keywords'.
 The return value is a function suitable for `syntax-propertize-function'."
-  (lexical-let ((keywords keywords))
-    (lambda (start end)
-      (with-no-warnings
-        (let ((font-lock-syntactic-keywords keywords))
-          (font-lock-fontify-syntactic-keywords-region start end)
-          ;; In case it was eval'd/compiled.
-          (setq keywords font-lock-syntactic-keywords))))))
+  (lambda (start end)
+    (with-no-warnings
+      (let ((font-lock-syntactic-keywords keywords))
+        (font-lock-fontify-syntactic-keywords-region start end)
+        ;; In case it was eval'd/compiled.
+        (setq keywords font-lock-syntactic-keywords)))))
 
 (defun syntax-propertize (pos)
   "Ensure that syntax-table properties are set until POS."
@@ -419,8 +424,8 @@ Point is at POS when this function returns."
 			    (* 2 (/ (cdr (aref syntax-ppss-stats 5))
 				    (1+ (car (aref syntax-ppss-stats 5)))))))
 	    (progn
-	      (incf (car (aref syntax-ppss-stats 0)))
-	      (incf (cdr (aref syntax-ppss-stats 0)) (- pos old-pos))
+	      (cl-incf (car (aref syntax-ppss-stats 0)))
+	      (cl-incf (cdr (aref syntax-ppss-stats 0)) (- pos old-pos))
 	      (parse-partial-sexp old-pos pos nil nil old-ppss))
 
 	  (cond
@@ -436,8 +441,8 @@ Point is at POS when this function returns."
 		 (setq pt-min (or (syntax-ppss-toplevel-pos old-ppss)
 				  (nth 2 old-ppss)))
 		 (<= pt-min pos) (< (- pos pt-min) syntax-ppss-max-span))
-	    (incf (car (aref syntax-ppss-stats 1)))
-	    (incf (cdr (aref syntax-ppss-stats 1)) (- pos pt-min))
+	    (cl-incf (car (aref syntax-ppss-stats 1)))
+	    (cl-incf (cdr (aref syntax-ppss-stats 1)) (- pos pt-min))
 	    (setq ppss (parse-partial-sexp pt-min pos)))
 	   ;; The OLD-* data can't be used.  Consult the cache.
 	   (t
@@ -465,8 +470,8 @@ Point is at POS when this function returns."
 	      ;; Use the best of OLD-POS and CACHE.
 	      (if (or (not old-pos) (< old-pos pt-min))
 		  (setq pt-best pt-min ppss-best ppss)
-		(incf (car (aref syntax-ppss-stats 4)))
-		(incf (cdr (aref syntax-ppss-stats 4)) (- pos old-pos))
+		(cl-incf (car (aref syntax-ppss-stats 4)))
+		(cl-incf (cdr (aref syntax-ppss-stats 4)) (- pos old-pos))
 		(setq pt-best old-pos ppss-best old-ppss))
 
 	      ;; Use the `syntax-begin-function' if available.
@@ -491,31 +496,29 @@ Point is at POS when this function returns."
 			 (not (memq (get-text-property (point) 'face)
 				    '(font-lock-string-face font-lock-doc-face
 				      font-lock-comment-face))))
-		(incf (car (aref syntax-ppss-stats 5)))
-		(incf (cdr (aref syntax-ppss-stats 5)) (- pos (point)))
+		(cl-incf (car (aref syntax-ppss-stats 5)))
+		(cl-incf (cdr (aref syntax-ppss-stats 5)) (- pos (point)))
 		(setq pt-best (point) ppss-best nil))
 
 	      (cond
 	       ;; Quick case when we found a nearby pos.
 	       ((< (- pos pt-best) syntax-ppss-max-span)
-		(incf (car (aref syntax-ppss-stats 2)))
-		(incf (cdr (aref syntax-ppss-stats 2)) (- pos pt-best))
+		(cl-incf (car (aref syntax-ppss-stats 2)))
+		(cl-incf (cdr (aref syntax-ppss-stats 2)) (- pos pt-best))
 		(setq ppss (parse-partial-sexp pt-best pos nil nil ppss-best)))
 	       ;; Slow case: compute the state from some known position and
 	       ;; populate the cache so we won't need to do it again soon.
 	       (t
-		(incf (car (aref syntax-ppss-stats 3)))
-		(incf (cdr (aref syntax-ppss-stats 3)) (- pos pt-min))
+		(cl-incf (car (aref syntax-ppss-stats 3)))
+		(cl-incf (cdr (aref syntax-ppss-stats 3)) (- pos pt-min))
 
 		;; If `pt-min' is too far, add a few intermediate entries.
 		(while (> (- pos pt-min) (* 2 syntax-ppss-max-span))
 		  (setq ppss (parse-partial-sexp
 			      pt-min (setq pt-min (/ (+ pt-min pos) 2))
 			      nil nil ppss))
-		  (let ((pair (cons pt-min ppss)))
-		    (if cache-pred
-			(push pair (cdr cache-pred))
-		      (push pair syntax-ppss-cache))))
+                  (push (cons pt-min ppss)
+                        (if cache-pred (cdr cache-pred) syntax-ppss-cache)))
 
 		;; Compute the actual return value.
 		(setq ppss (parse-partial-sexp pt-min pos nil nil ppss))
diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el
index 32ec2bbf7ee..8aa722521eb 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -1,16 +1,16 @@
-;;; tabulated-list.el --- generic major mode for tabulated lists.
+;;; tabulated-list.el --- generic major mode for tabulated lists -*- lexical-binding: t -*-
 
-;; Copyright (C) 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
 
 ;; Author: Chong Yidong <cyd@stupidchicken.com>
 ;; Keywords: extensions, lisp
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, 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
@@ -22,22 +22,31 @@
 
 ;;; Commentary:
 
-;; This file defines `tabulated-list-mode', a generic major mode for displaying
-;; lists of tabulated data, intended for other major modes to inherit from.  It
-;; provides several utility routines, e.g. for pretty-printing lines of
-;; tabulated data to fit into the appropriate columns.
+;; This file defines Tabulated List mode, a generic major mode for
+;; displaying lists of tabulated data, intended for other major modes
+;; to inherit from.  It provides several utility routines, e.g. for
+;; pretty-printing lines of tabulated data to fit into the appropriate
+;; columns.
 
 ;; For usage information, see the documentation of `tabulated-list-mode'.
 
-;; This package originated from Tom Tromey's Package Menu mode, extended and
-;; generalized to be used by other modes.
+;; This package originated from Tom Tromey's Package Menu mode,
+;; extended and generalized to be used by other modes.
 
 ;;; Code:
 
+;; The reason `tabulated-list-format' and other variables are
+;; permanent-local is to make it convenient to switch to a different
+;; major mode, switch back, and have the original Tabulated List data
+;; still valid.  See, for example, ebuff-menu.el.
+
 (defvar tabulated-list-format nil
   "The format of the current Tabulated List mode buffer.
-This should be a vector of elements (NAME WIDTH SORT), where:
+This should be a vector of elements (NAME WIDTH SORT . PROPS),
+where:
  - NAME is a string describing the column.
+   This is the label for the column in the header line.
+   Different columns must have non-`equal' names.
  - WIDTH is the width to reserve for the column.
    For the final element, its numerical value is ignored.
  - SORT specifies how to sort entries by this column.
@@ -45,8 +54,18 @@ This should be a vector of elements (NAME WIDTH SORT), where:
    If t, sort by comparing the string value printed in the column.
    Otherwise, it should be a predicate function suitable for
    `sort', accepting arguments with the same form as the elements
-   of `tabulated-list-entries'.")
+   of `tabulated-list-entries'.
+ - PROPS is a plist of additional column properties.
+   Currently supported properties are:
+   - `:right-align': if non-nil, the column should be right-aligned.
+   - `:pad-right': Number of additional padding spaces to the
+     right of the column (defaults to 1 if omitted).")
 (make-variable-buffer-local 'tabulated-list-format)
+(put 'tabulated-list-format 'permanent-local t)
+
+(defvar tabulated-list-use-header-line t
+  "Whether the Tabulated List buffer should use a header line.")
+(make-variable-buffer-local 'tabulated-list-use-header-line)
 
 (defvar tabulated-list-entries nil
   "Entries displayed in the current Tabulated List buffer.
@@ -67,12 +86,14 @@ where:
 If `tabulated-list-entries' is a function, it is called with no
 arguments and must return a list of the above form.")
 (make-variable-buffer-local 'tabulated-list-entries)
+(put 'tabulated-list-entries 'permanent-local t)
 
 (defvar tabulated-list-padding 0
   "Number of characters preceding each Tabulated List mode entry.
 By default, lines are padded with spaces, but you can use the
 function `tabulated-list-put-tag' to change this.")
 (make-variable-buffer-local 'tabulated-list-padding)
+(put 'tabulated-list-padding 'permanent-local t)
 
 (defvar tabulated-list-revert-hook nil
   "Hook run before reverting a Tabulated List buffer.
@@ -94,13 +115,20 @@ NAME is a string matching one of the column names in
 `tabulated-list-format' then specifies how to sort).  FLIP, if
 non-nil, means to invert the resulting sort.")
 (make-variable-buffer-local 'tabulated-list-sort-key)
+(put 'tabulated-list-sort-key 'permanent-local t)
 
-(defun tabulated-list-get-id (&optional pos)
-  "Obtain the entry ID of the Tabulated List mode entry at POS.
-This is an ID object from `tabulated-list-entries', or nil.
+(defsubst tabulated-list-get-id (&optional pos)
+  "Return the entry ID of the Tabulated List entry at POS.
+The value is an ID object from `tabulated-list-entries', or nil.
 POS, if omitted or nil, defaults to point."
   (get-text-property (or pos (point)) 'tabulated-list-id))
 
+(defsubst tabulated-list-get-entry (&optional pos)
+  "Return the Tabulated List entry at POS.
+The value is a vector of column descriptors, or nil if there is
+no entry at POS.  POS, if omitted or nil, defaults to point."
+  (get-text-property (or pos (point)) 'tabulated-list-entry))
+
 (defun tabulated-list-put-tag (tag &optional advance)
   "Put TAG in the padding area of the current line.
 TAG should be a string, with length <= `tabulated-list-padding'.
@@ -111,16 +139,16 @@ If ADVANCE is non-nil, move forward by one line afterwards."
     (error "Unable to tag the current line"))
   (save-excursion
     (beginning-of-line)
-    (when (get-text-property (point) 'tabulated-list-id)
+    (when (tabulated-list-get-entry)
       (let ((beg (point))
 	    (inhibit-read-only t))
 	(forward-char tabulated-list-padding)
 	(insert-and-inherit
-	 (if (<= (length tag) tabulated-list-padding)
-	     (concat tag
-		     (make-string (- tabulated-list-padding (length tag))
-				  ?\s))
-	   (substring tag 0 tabulated-list-padding)))
+	 (let ((width (string-width tag)))
+	   (if (<= width tabulated-list-padding)
+	       (concat tag
+		       (make-string (- tabulated-list-padding width) ?\s))
+	     (truncate-string-to-width tag tabulated-list-padding))))
 	(delete-region beg (+ beg tabulated-list-padding)))))
   (if advance
       (forward-line)))
@@ -130,6 +158,7 @@ If ADVANCE is non-nil, move forward by one line afterwards."
     (set-keymap-parent map button-buffer-map)
     (define-key map "n" 'next-line)
     (define-key map "p" 'previous-line)
+    (define-key map "S" 'tabulated-list-sort)
     (define-key map [follow-link] 'mouse-face)
     (define-key map [mouse-2] 'mouse-select-window)
     map)
@@ -139,6 +168,9 @@ If ADVANCE is non-nil, move forward by one line afterwards."
   (let ((map (make-sparse-keymap)))
     (define-key map [header-line mouse-1] 'tabulated-list-col-sort)
     (define-key map [header-line mouse-2] 'tabulated-list-col-sort)
+    (define-key map [mouse-1] 'tabulated-list-col-sort)
+    (define-key map [mouse-2] 'tabulated-list-col-sort)
+    (define-key map "\C-m" 'tabulated-list-sort)
     (define-key map [follow-link] 'mouse-face)
     map)
   "Local keymap for `tabulated-list-mode' sort buttons.")
@@ -152,50 +184,79 @@ If ADVANCE is non-nil, move forward by one line afterwards."
     table)
   "The `glyphless-char-display' table in Tabulated List buffers.")
 
+(defvar tabulated-list--header-string nil)
+(defvar tabulated-list--header-overlay nil)
+
 (defun tabulated-list-init-header ()
   "Set up header line for the Tabulated List buffer."
-  (let ((x tabulated-list-padding)
+  ;; FIXME: Should share code with tabulated-list-print-col!
+  (let ((x (max tabulated-list-padding 0))
 	(button-props `(help-echo "Click to sort by column"
 			mouse-face highlight
 			keymap ,tabulated-list-sort-button-map))
 	(cols nil))
-    (if (> tabulated-list-padding 0)
-	(push (propertize " " 'display `(space :align-to ,x)) cols))
+    (push (propertize " " 'display `(space :align-to ,x)) cols)
     (dotimes (n (length tabulated-list-format))
       (let* ((col (aref tabulated-list-format n))
+	     (label (nth 0 col))
 	     (width (nth 1 col))
-	     (label (car col)))
-	(setq x (+ x 1 width))
-	(and (<= tabulated-list-padding 0)
-	     (= n 0)
-	     (setq label (concat " " label)))
+	     (props (nthcdr 3 col))
+	     (pad-right (or (plist-get props :pad-right) 1))
+             (right-align (plist-get props :right-align))
+             (next-x (+ x pad-right width)))
 	(push
 	 (cond
 	  ;; An unsortable column
-	  ((not (nth 2 col)) label)
+	  ((not (nth 2 col))
+	   (propertize label 'tabulated-list-column-name label))
 	  ;; The selected sort column
 	  ((equal (car col) (car tabulated-list-sort-key))
 	   (apply 'propertize
 		  (concat label
 			  (cond
-			   ((> (+ 2 (length label)) width)
-			    "")
-			   ((cdr tabulated-list-sort-key)
-			    " ▲")
+			   ((> (+ 2 (length label)) width) "")
+			   ((cdr tabulated-list-sort-key) " ▲")
 			   (t " ▼")))
 		  'face 'bold
-		  'tabulated-list-column-name (car col)
+		  'tabulated-list-column-name label
 		  button-props))
 	  ;; Unselected sortable column.
 	  (t (apply 'propertize label
-		    'tabulated-list-column-name (car col)
+		    'tabulated-list-column-name label
 		    button-props)))
-	 cols))
-      (push (propertize " "
-			'display (list 'space :align-to x)
-			'face 'fixed-pitch)
-	    cols))
-    (setq header-line-format (mapconcat 'identity (nreverse cols) ""))))
+	 cols)
+        (when right-align
+          (let ((shift (- width (string-width (car cols)))))
+            (when (> shift 0)
+              (setq cols
+                    (cons (car cols)
+                          (cons (propertize (make-string shift ?\s)
+                                            'display
+                                            `(space :align-to ,(+ x shift)))
+                                (cdr cols))))
+              (setq x (+ x shift)))))
+	(if (> pad-right 0)
+	    (push (propertize " "
+			      'display `(space :align-to ,next-x)
+			      'face 'fixed-pitch)
+		  cols))
+        (setq x next-x)))
+    (setq cols (apply 'concat (nreverse cols)))
+    (if tabulated-list-use-header-line
+	(setq header-line-format cols)
+      (setq header-line-format nil)
+      (set (make-local-variable 'tabulated-list--header-string) cols))))
+
+(defun tabulated-list-print-fake-header ()
+  "Insert a fake Tabulated List \"header line\" at the start of the buffer."
+  (goto-char (point-min))
+  (let ((inhibit-read-only t))
+    (insert tabulated-list--header-string "\n")
+    (if tabulated-list--header-overlay
+	(move-overlay tabulated-list--header-overlay (point-min) (point))
+      (set (make-local-variable 'tabulated-list--header-overlay)
+	   (make-overlay (point-min) (point))))
+    (overlay-put tabulated-list--header-overlay 'face 'underline)))
 
 (defun tabulated-list-revert (&rest ignored)
   "The `revert-buffer-function' for `tabulated-list-mode'.
@@ -206,6 +267,17 @@ It runs `tabulated-list-revert-hook', then calls `tabulated-list-print'."
   (run-hooks 'tabulated-list-revert-hook)
   (tabulated-list-print t))
 
+(defun tabulated-list--column-number (name)
+  (let ((len (length tabulated-list-format))
+	(n 0)
+	found)
+    (while (and (< n len) (null found))
+      (if (equal (car (aref tabulated-list-format n)) name)
+	  (setq found n))
+      (setq n (1+ n)))
+    (or found
+	(error "No column named %s" name))))
+
 (defun tabulated-list-print (&optional remember-pos)
   "Populate the current Tabulated List mode buffer.
 This sorts the `tabulated-list-entries' list if sorting is
@@ -215,7 +287,7 @@ buffer and inserts the entries with `tabulated-list-printer'.
 Optional argument REMEMBER-POS, if non-nil, means to move point
 to the entry with the same ID element as the current line."
   (let ((inhibit-read-only t)
-	(entries (if (functionp 'tabulated-list-entries)
+	(entries (if (functionp tabulated-list-entries)
 		     (funcall tabulated-list-entries)
 		   tabulated-list-entries))
 	entry-id saved-pt saved-col)
@@ -223,19 +295,16 @@ to the entry with the same ID element as the current line."
 	 (setq entry-id (tabulated-list-get-id))
 	 (setq saved-col (current-column)))
     (erase-buffer)
-    ;; Sort the buffers, if necessary.
-    (when tabulated-list-sort-key
-      (let ((sort-column (car tabulated-list-sort-key))
-	    (len (length tabulated-list-format))
-	    (n 0)
-	    sorter)
-	;; Which column is to be sorted?
-	(while (and (< n len)
-		    (not (equal (car (aref tabulated-list-format n))
-				sort-column)))
-	  (setq n (1+ n)))
-	(when (< n len)
-	  (setq sorter (nth 2 (aref tabulated-list-format n)))
+    (unless tabulated-list-use-header-line
+      (tabulated-list-print-fake-header))
+    ;; Sort the entries, if necessary.
+    (when (and tabulated-list-sort-key
+	       (car tabulated-list-sort-key))
+      (let* ((sort-column (car tabulated-list-sort-key))
+	     (n (tabulated-list--column-number sort-column))
+	     (sorter (nth 2 (aref tabulated-list-format n))))
+	;; Is the specified column sortable?
+	(when sorter
 	  (when (eq sorter t)
 	    (setq sorter ; Default sorter checks column N:
 		  (lambda (A B)
@@ -246,7 +315,7 @@ to the entry with the same ID element as the current line."
 	  (setq entries (sort entries sorter))
 	  (if (cdr tabulated-list-sort-key)
 	      (setq entries (nreverse entries)))
-	  (unless (functionp 'tabulated-list-entries)
+	  (unless (functionp tabulated-list-entries)
 	    (setq tabulated-list-entries entries)))))
     ;; Print the resulting list.
     (dolist (elt entries)
@@ -267,54 +336,153 @@ to the entry with the same ID element as the current line."
 This is the default `tabulated-list-printer' function.  ID is a
 Lisp object identifying the entry to print, and COLS is a vector
 of column descriptors."
-  (let ((beg (point))
-	(x (max tabulated-list-padding 0))
-	(len (length tabulated-list-format)))
+  (let ((beg   (point))
+	(x     (max tabulated-list-padding 0))
+	(ncols (length tabulated-list-format))
+	(inhibit-read-only t))
     (if (> tabulated-list-padding 0)
 	(insert (make-string x ?\s)))
-    (dotimes (n len)
-      (let* ((format (aref tabulated-list-format n))
-	     (desc   (aref cols n))
-	     (width  (nth 1 format))
-	     (label  (if (stringp desc) desc (car desc)))
-	     (help-echo (concat (car format) ": " label)))
-	;; Truncate labels if necessary.
-	(and (> width 6)
-	     (> (length label) width)
-	     (setq label (concat (substring label 0 (- width 3))
-				 "...")))
-	(setq label (bidi-string-mark-left-to-right label))
-	(if (stringp desc)
-	    (insert (propertize label 'help-echo help-echo))
-	  (apply 'insert-text-button label (cdr desc)))
-	(setq x (+ x 1 width)))
-      ;; No need to append any spaces if this is the last column.
-      (if (< (1+ n) len)
-	  (indent-to x 1)))
+    (dotimes (n ncols)
+      (setq x (tabulated-list-print-col n (aref cols n) x)))
     (insert ?\n)
-    (put-text-property beg (point) 'tabulated-list-id id)))
+    (put-text-property beg (point) 'tabulated-list-id id)
+    (put-text-property beg (point) 'tabulated-list-entry cols)))
+
+(defun tabulated-list-print-col (n col-desc x)
+  "Insert a specified Tabulated List entry at point.
+N is the column number, COL-DESC is a column descriptor \(see
+`tabulated-list-entries'), and X is the column number at point.
+Return the column number after insertion."
+  ;; TODO: don't truncate to `width' if the next column is align-right
+  ;; and has some space left.
+  (let* ((format    (aref tabulated-list-format n))
+	 (name      (nth 0 format))
+	 (width     (nth 1 format))
+	 (props     (nthcdr 3 format))
+	 (pad-right (or (plist-get props :pad-right) 1))
+         (right-align (plist-get props :right-align))
+	 (label     (if (stringp col-desc) col-desc (car col-desc)))
+         (label-width (string-width label))
+	 (help-echo (concat (car format) ": " label))
+	 (opoint (point))
+	 (not-last-col (< (1+ n) (length tabulated-list-format))))
+    ;; Truncate labels if necessary (except last column).
+    (and not-last-col
+	 (> label-width width)
+	 (setq label (truncate-string-to-width label width nil nil t)
+               label-width width))
+    (setq label (bidi-string-mark-left-to-right label))
+    (when (and right-align (> width label-width))
+      (let ((shift (- width label-width)))
+        (insert (propertize (make-string shift ?\s)
+                            'display `(space :align-to ,(+ x shift))))
+        (setq width (- width shift))
+        (setq x (+ x shift))))
+    (if (stringp col-desc)
+	(insert (propertize label 'help-echo help-echo))
+      (apply 'insert-text-button label (cdr col-desc)))
+    (let ((next-x (+ x pad-right width)))
+      ;; No need to append any spaces if this is the last column.
+      (when not-last-col
+        (when (> pad-right 0) (insert (make-string pad-right ?\s)))
+        (insert (propertize
+                 (make-string (- next-x x label-width pad-right) ?\s)
+                 'display `(space :align-to ,next-x))))
+      (put-text-property opoint (point) 'tabulated-list-column-name name)
+      next-x)))
+
+(defun tabulated-list-delete-entry ()
+  "Delete the Tabulated List entry at point.
+Return a list (ID COLS), where ID is the ID of the deleted entry
+and COLS is a vector of its column descriptors.  Move point to
+the beginning of the deleted entry.  Return nil if there is no
+entry at point.
+
+This function only changes the buffer contents; it does not alter
+`tabulated-list-entries'."
+  ;; Assume that each entry occupies one line.
+  (let* ((id (tabulated-list-get-id))
+	 (cols (tabulated-list-get-entry))
+	 (inhibit-read-only t))
+    (when cols
+      (delete-region (line-beginning-position) (1+ (line-end-position)))
+      (list id cols))))
+
+(defun tabulated-list-set-col (col desc &optional change-entry-data)
+  "Change the Tabulated List entry at point, setting COL to DESC.
+COL is the column number to change, or the name of the column to change.
+DESC is the new column descriptor, which is inserted via
+`tabulated-list-print-col'.
+
+If CHANGE-ENTRY-DATA is non-nil, modify the underlying entry data
+by setting the appropriate slot of the vector originally used to
+print this entry.  If `tabulated-list-entries' has a list value,
+this is the vector stored within it."
+  (let* ((opoint (point))
+	 (eol    (line-end-position))
+	 (pos    (line-beginning-position))
+	 (id     (tabulated-list-get-id pos))
+	 (entry  (tabulated-list-get-entry pos))
+	 (prop 'tabulated-list-column-name)
+	 (inhibit-read-only t)
+	 name)
+    (cond ((numberp col)
+	   (setq name (car (aref tabulated-list-format col))))
+	  ((stringp col)
+	   (setq name col
+		 col (tabulated-list--column-number col)))
+	  (t
+	   (error "Invalid column %s" col)))
+    (unless entry
+      (error "No Tabulated List entry at position %s" opoint))
+    (unless (equal (get-text-property pos prop) name)
+      (while (and (setq pos
+			(next-single-property-change pos prop nil eol))
+		  (< pos eol)
+		  (not (equal (get-text-property pos prop) name)))))
+    (when (< pos eol)
+      (delete-region pos (next-single-property-change pos prop nil eol))
+      (goto-char pos)
+      (tabulated-list-print-col col desc (current-column))
+      (if change-entry-data
+	  (aset entry col desc))
+      (put-text-property pos (point) 'tabulated-list-id id)
+      (put-text-property pos (point) 'tabulated-list-entry entry)
+      (goto-char opoint))))
 
 (defun tabulated-list-col-sort (&optional e)
   "Sort Tabulated List entries by the column of the mouse click E."
   (interactive "e")
   (let* ((pos (event-start e))
-	 (obj (posn-object pos))
-	 (name (get-text-property (if obj (cdr obj) (posn-point pos))
-				  'tabulated-list-column-name
-				  (car obj))))
+	 (obj (posn-object pos)))
     (with-current-buffer (window-buffer (posn-window pos))
-      (when (derived-mode-p 'tabulated-list-mode)
-	;; Flip the sort order on a second click.
-	(if (equal name (car tabulated-list-sort-key))
-	    (setcdr tabulated-list-sort-key
-		    (not (cdr tabulated-list-sort-key)))
-	  (setq tabulated-list-sort-key (cons name nil)))
-	(tabulated-list-init-header)
-	(tabulated-list-print t)))))
+      (tabulated-list--sort-by-column-name
+       (get-text-property (if obj (cdr obj) (posn-point pos))
+			  'tabulated-list-column-name
+			  (car obj))))))
+
+(defun tabulated-list-sort (&optional n)
+  "Sort Tabulated List entries by the column at point.
+With a numeric prefix argument N, sort the Nth column."
+  (interactive "P")
+  (let ((name (if n
+		  (car (aref tabulated-list-format n))
+		(get-text-property (point)
+				   'tabulated-list-column-name))))
+    (tabulated-list--sort-by-column-name name)))
+
+(defun tabulated-list--sort-by-column-name (name)
+  (when (and name (derived-mode-p 'tabulated-list-mode))
+    ;; Flip the sort order on a second click.
+    (if (equal name (car tabulated-list-sort-key))
+	(setcdr tabulated-list-sort-key
+		(not (cdr tabulated-list-sort-key)))
+      (setq tabulated-list-sort-key (cons name nil)))
+    (tabulated-list-init-header)
+    (tabulated-list-print t)))
 
 ;;; The mode definition:
 
-;;;###autoload
 (define-derived-mode tabulated-list-mode special-mode "Tabulated"
   "Generic major mode for browsing a list of items.
 This mode is usually not used directly; instead, other major
@@ -362,7 +530,6 @@ as the ewoc pretty-printer."
 
 ;; Local Variables:
 ;; coding: utf-8
-;; lexical-binding: t
 ;; End:
 
 ;;; tabulated-list.el ends here
diff --git a/lisp/emacs-lisp/tcover-ses.el b/lisp/emacs-lisp/tcover-ses.el
index b91b96b83e5..79251bfd6e1 100644
--- a/lisp/emacs-lisp/tcover-ses.el
+++ b/lisp/emacs-lisp/tcover-ses.el
@@ -1,6 +1,6 @@
 ;;;; testcover-ses.el -- Example use of `testcover' to test "SES"
 
-;; Copyright (C) 2002-2011  Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012  Free Software Foundation, Inc.
 
 ;; Author: Jonathan Yavner <jyavner@engineer.com>
 ;; Maintainer: Jonathan Yavner <jyavner@engineer.com>
diff --git a/lisp/emacs-lisp/tcover-unsafep.el b/lisp/emacs-lisp/tcover-unsafep.el
index 7144138445c..2de6e6c5bc0 100644
--- a/lisp/emacs-lisp/tcover-unsafep.el
+++ b/lisp/emacs-lisp/tcover-unsafep.el
@@ -1,6 +1,6 @@
 ;;;; testcover-unsafep.el -- Use testcover to test unsafep's code coverage
 
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
 
 ;; Author: Jonathan Yavner <jyavner@engineer.com>
 ;; Maintainer: Jonathan Yavner <jyavner@engineer.com>
diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el
index a5a6f71d79e..5fdc8c55a85 100644
--- a/lisp/emacs-lisp/testcover.el
+++ b/lisp/emacs-lisp/testcover.el
@@ -1,6 +1,6 @@
 ;;;; testcover.el -- Visual code-coverage tool
 
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
 
 ;; Author: Jonathan Yavner <jyavner@member.fsf.org>
 ;; Maintainer: Jonathan Yavner <jyavner@member.fsf.org>
@@ -270,9 +270,9 @@ value, 'maybe if either is acceptable."
       (setq id (nth 2 form))
       (setcdr form (nthcdr 2 form))
       (setq val (testcover-reinstrument (nth 2 form)))
-      (if (eq val t)
-	  (setcar form 'testcover-1value)
-	(setcar form 'testcover-after))
+      (setcar form (if (eq val t)
+                       'testcover-1value
+                     'testcover-after))
       (when val
 	;;1-valued or potentially 1-valued
 	(aset testcover-vector id '1value))
@@ -359,9 +359,9 @@ value, 'maybe if either is acceptable."
 					      ,(nth 3 (cadr form))))
 	t)
        (t
-	(if (eq (car (cadr form)) 'edebug-after)
-	    (setq id (car (nth 3 (cadr form))))
-	  (setq id (car (cadr form))))
+	(setq id (car (if (eq (car (cadr form)) 'edebug-after)
+                          (nth 3 (cadr form))
+                        (cadr form))))
 	(let ((testcover-1value-functions
 	       (cons id testcover-1value-functions)))
 	  (testcover-reinstrument (cadr form))))))
@@ -379,9 +379,9 @@ value, 'maybe if either is acceptable."
 				   ,(nth 3 (cadr form))))
 	'maybe)
        (t
-	(if (eq (car (cadr form)) 'edebug-after)
-	    (setq id (car (nth 3 (cadr form))))
-	  (setq id (car (cadr form))))
+	(setq id (car (if (eq (car (cadr form)) 'edebug-after)
+                          (nth 3 (cadr form))
+                        (cadr form))))
 	(let ((testcover-noreturn-functions
 	       (cons id testcover-noreturn-functions)))
 	  (testcover-reinstrument (cadr form))))))
@@ -447,6 +447,12 @@ binding `testcover-vector' to the code-coverage vector for TESTCOVER-SYM
 (defun testcover-after (idx val)
   "Internal function for coverage testing.  Returns VAL after installing it in
 `testcover-vector' at offset IDX."
+  (declare (gv-expander (lambda (do)
+                          (gv-letplace (getter setter) val
+                            (funcall do getter
+                                     (lambda (store)
+                                       `(progn (testcover-after ,idx ,getter)
+                                               ,(funcall setter store))))))))
   (cond
    ((eq (aref testcover-vector idx) 'unknown)
     (aset testcover-vector idx val))
diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el
index 706c6fd0ba3..284c591fc61 100644
--- a/lisp/emacs-lisp/timer.el
+++ b/lisp/emacs-lisp/timer.el
@@ -1,6 +1,6 @@
 ;;; timer.el --- run a function with args at some time in future
 
-;; Copyright (C) 1996, 2001-2011  Free Software Foundation, Inc.
+;; Copyright (C) 1996, 2001-2012  Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Package: emacs
@@ -29,40 +29,48 @@
 
 ;; Layout of a timer vector:
 ;; [triggered-p high-seconds low-seconds usecs repeat-delay
-;;  function args idle-delay]
+;;  function args idle-delay psecs]
 ;; triggered-p is nil if the timer is active (waiting to be triggered),
 ;;  t if it is inactive ("already triggered", in theory)
 
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
 
-(defstruct (timer
+(cl-defstruct (timer
             (:constructor nil)
             (:copier nil)
             (:constructor timer-create ())
             (:type vector)
             (:conc-name timer--))
   (triggered t)
-  high-seconds low-seconds usecs repeat-delay function args idle-delay)
+  high-seconds low-seconds usecs repeat-delay function args idle-delay psecs)
 
 (defun timerp (object)
   "Return t if OBJECT is a timer."
-  (and (vectorp object) (= (length object) 8)))
+  (and (vectorp object) (= (length object) 9)))
 
 ;; Pseudo field `time'.
 (defun timer--time (timer)
   (list (timer--high-seconds timer)
         (timer--low-seconds timer)
-        (timer--usecs timer)))
+	(timer--usecs timer)
+	(timer--psecs timer)))
 
-(defsetf timer--time
+(gv-define-simple-setter timer--time
   (lambda (timer time)
     (or (timerp timer) (error "Invalid timer"))
     (setf (timer--high-seconds timer) (pop time))
-    (setf (timer--low-seconds timer)
-	  (if (consp time) (car time) time))
-    (setf (timer--usecs timer) (or (and (consp time) (consp (cdr time))
-					(cadr time))
-				   0))))
+    (let ((low time) (usecs 0) (psecs 0))
+      (if (consp time)
+	  (progn
+	    (setq low (pop time))
+	    (if time
+		(progn
+		  (setq usecs (pop time))
+		  (if time
+		      (setq psecs (car time)))))))
+      (setf (timer--low-seconds timer) low)
+      (setf (timer--usecs timer) usecs)
+      (setf (timer--psecs timer) psecs))))
 
 
 (defun timer-set-time (timer time &optional delta)
@@ -77,7 +85,7 @@ fire repeatedly that many seconds apart."
 (defun timer-set-idle-time (timer secs &optional repeat)
   "Set the trigger idle time of TIMER to SECS.
 SECS may be an integer, floating point number, or the internal
-time format (HIGH LOW USECS) returned by, e.g., `current-idle-time'.
+time format returned by, e.g., `current-idle-time'.
 If optional third argument REPEAT is non-nil, make the timer
 fire each time Emacs is idle for that many seconds."
   (if (consp secs)
@@ -91,41 +99,46 @@ fire each time Emacs is idle for that many seconds."
   "Yield the next value after TIME that is an integral multiple of SECS.
 More precisely, the next value, after TIME, that is an integral multiple
 of SECS seconds since the epoch.  SECS may be a fraction."
-  (let ((time-base (ash 1 16)))
-    ;; Use floating point, taking care to not lose precision.
-    (let* ((float-time-base (float time-base))
-	   (million 1000000.0)
-	   (time-usec (+ (* million
-			    (+ (* float-time-base (nth 0 time))
-			       (nth 1 time)))
-			 (nth 2 time)))
-	   (secs-usec (* million secs))
-	   (mod-usec (mod time-usec secs-usec))
-	   (next-usec (+ (- time-usec mod-usec) secs-usec))
-	   (time-base-million (* float-time-base million)))
-      (list (floor next-usec time-base-million)
-	    (floor (mod next-usec time-base-million) million)
-	    (floor (mod next-usec million))))))
-
-(defun timer-relative-time (time secs &optional usecs)
-  "Advance TIME by SECS seconds and optionally USECS microseconds.
-SECS may be either an integer or a floating point number."
+  (let* ((trillion 1e12)
+	 (time-sec (+ (nth 1 time)
+		      (* 65536.0 (nth 0 time))))
+	 (delta-sec (mod (- time-sec) secs))
+	 (next-sec (+ time-sec (ffloor delta-sec)))
+	 (next-sec-psec (ffloor (* trillion (mod delta-sec 1))))
+	 (sub-time-psec (+ (or (nth 3 time) 0)
+			   (* 1e6 (nth 2 time))))
+	 (psec-diff (- sub-time-psec next-sec-psec)))
+    (if (and (<= next-sec time-sec) (< 0 psec-diff))
+	(setq next-sec-psec (+ sub-time-psec
+			       (mod (- psec-diff) (* trillion secs)))))
+    (setq next-sec (+ next-sec (floor next-sec-psec trillion)))
+    (setq next-sec-psec (mod next-sec-psec trillion))
+    (list (floor next-sec 65536)
+	  (floor (mod next-sec 65536))
+	  (floor next-sec-psec 1000000)
+	  (floor (mod next-sec-psec 1000000)))))
+
+(defun timer-relative-time (time secs &optional usecs psecs)
+  "Advance TIME by SECS seconds and optionally USECS nanoseconds
+and PSECS picoseconds.  SECS may be either an integer or a
+floating point number."
   (let ((delta (if (floatp secs)
 		   (seconds-to-time secs)
 		 (list (floor secs 65536) (mod secs 65536)))))
-    (if usecs
-	(setq delta (time-add delta (list 0 0 usecs))))
+    (if (or usecs psecs)
+	(setq delta (time-add delta (list 0 0 (or usecs 0) (or psecs 0)))))
     (time-add time delta)))
 
 (defun timer--time-less-p (t1 t2)
   "Say whether time value T1 is less than time value T2."
   (time-less-p (timer--time t1) (timer--time t2)))
 
-(defun timer-inc-time (timer secs &optional usecs)
-  "Increment the time set in TIMER by SECS seconds and USECS microseconds.
-SECS may be a fraction.  If USECS is omitted, that means it is zero."
+(defun timer-inc-time (timer secs &optional usecs psecs)
+  "Increment the time set in TIMER by SECS seconds, USECS nanoseconds,
+and PSECS picoseconds.  SECS may be a fraction.  If USECS or PSECS are
+omitted, they are treated as zero."
   (setf (timer--time timer)
-        (timer-relative-time (timer--time timer) secs usecs)))
+        (timer-relative-time (timer--time timer) secs usecs psecs)))
 
 (defun timer-set-time-with-usecs (timer time usecs &optional delta)
   "Set the trigger time of TIMER to TIME plus USECS.
@@ -133,13 +146,13 @@ TIME must be in the internal format returned by, e.g., `current-time'.
 The microsecond count from TIME is ignored, and USECS is used instead.
 If optional fourth argument DELTA is a positive number, make the timer
 fire repeatedly that many seconds apart."
+  (declare (obsolete "use `timer-set-time' and `timer-inc-time' instead."
+		     "22.1"))
   (setf (timer--time timer) time)
   (setf (timer--usecs timer) usecs)
+  (setf (timer--psecs timer) 0)
   (setf (timer--repeat-delay timer) (and (numberp delta) (> delta 0) delta))
   timer)
-(make-obsolete 'timer-set-time-with-usecs
-               "use `timer-set-time' and `timer-inc-time' instead."
-               "22.1")
 
 (defun timer-set-function (timer function &optional args)
   "Make TIMER call FUNCTION with optional ARGS when triggering."
@@ -154,6 +167,7 @@ fire repeatedly that many seconds apart."
 	   (integerp (timer--high-seconds timer))
 	   (integerp (timer--low-seconds timer))
 	   (integerp (timer--usecs timer))
+	   (integerp (timer--psecs timer))
 	   (timer--function timer))
       (let ((timers (if idle timer-idle-list timer-list))
 	    last)
@@ -190,12 +204,19 @@ timers).  If nil, allocate a new cell."
   "Insert TIMER into `timer-idle-list'.
 This arranges to activate TIMER whenever Emacs is next idle.
 If optional argument DONT-WAIT is non-nil, set TIMER to activate
-immediately, or at the right time, if Emacs is already idle.
+immediately \(see below\), or at the right time, if Emacs is
+already idle.
 
 REUSE-CELL, if non-nil, is a cons cell to reuse when inserting
 TIMER into `timer-idle-list' (usually a cell removed from that
 list by `cancel-timer-internal'; using this reduces consing for
-repeat timers).  If nil, allocate a new cell."
+repeat timers).  If nil, allocate a new cell.
+
+Using non-nil DONT-WAIT is not recommended when activating an
+idle timer from an idle timer handler, if the timer being
+activated has an idleness time that is smaller or equal to
+the time of the current timer.  That's because the activated
+timer will fire right away."
   (timer--activate timer (not dont-wait) reuse-cell 'idle))
 
 (defalias 'disable-timeout 'cancel-timer)
@@ -240,18 +261,20 @@ and idle timers such as are scheduled by `run-with-idle-timer'."
 (defvar timer-event-last-2 nil
   "Third-to-last timer that was run.")
 
-(defvar timer-max-repeats 10
-  "*Maximum number of times to repeat a timer, if many repeats are delayed.
+(defcustom timer-max-repeats 10
+  "Maximum number of times to repeat a timer, if many repeats are delayed.
 Timer invocations can be delayed because Emacs is suspended or busy,
 or because the system's time changes.  If such an occurrence makes it
 appear that many invocations are overdue, this variable controls
-how many will really happen.")
+how many will really happen."
+  :type 'integer
+  :group 'internal)
 
 (defun timer-until (timer time)
   "Calculate number of seconds from when TIMER will run, until TIME.
 TIMER is a timer, and stands for the time when its next repeat is scheduled.
 TIME is a time-list."
-  (float-time (time-subtract time (timer--time timer))))
+  (- (float-time time) (float-time (timer--time timer))))
 
 (defun timer-event-handler (timer)
   "Call the handler for the timer TIMER.
@@ -384,9 +407,11 @@ This function is for compatibility; see also `run-with-timer'."
   "Perform an action the next time Emacs is idle for SECS seconds.
 The action is to call FUNCTION with arguments ARGS.
 SECS may be an integer, a floating point number, or the internal
-time format (HIGH LOW USECS) returned by, e.g., `current-idle-time'.
+time format returned by, e.g., `current-idle-time'.
 If Emacs is currently idle, and has been idle for N seconds (N < SECS),
-then it will call FUNCTION in SECS - N seconds from now.
+then it will call FUNCTION in SECS - N seconds from now.  Using
+SECS <= N is not recommended if this function is invoked from an idle
+timer, because FUNCTION will then be called immediately.
 
 If REPEAT is non-nil, do the action each time Emacs has been idle for
 exactly SECS seconds (that is, only once for each time Emacs becomes idle).
@@ -425,7 +450,7 @@ be detected.
                      (with-timeout-timers
                          (cons -with-timeout-timer- with-timeout-timers)))
                 (unwind-protect
-                    ,@body
+                    (progn ,@body)
                   (cancel-timer -with-timeout-timer-))))))
        ;; It is tempting to avoid the `if' altogether and instead run
        ;; timeout-forms in the timer, just before throwing `timeout'.
diff --git a/lisp/emacs-lisp/tq.el b/lisp/emacs-lisp/tq.el
index 3d3b371ad5c..0d13a3caed0 100644
--- a/lisp/emacs-lisp/tq.el
+++ b/lisp/emacs-lisp/tq.el
@@ -1,6 +1,6 @@
 ;;; tq.el --- utility to maintain a transaction queue
 
-;; Copyright (C) 1985-1987, 1992, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1992, 2001-2012 Free Software Foundation, Inc.
 
 ;; Author: Scott Draves <spot@cs.cmu.edu>
 ;; Maintainer: FSF
diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el
index 22c1f0e7ea7..722e6270e95 100644
--- a/lisp/emacs-lisp/trace.el
+++ b/lisp/emacs-lisp/trace.el
@@ -1,6 +1,6 @@
-;;; trace.el --- tracing facility for Emacs Lisp functions
+;;; trace.el --- tracing facility for Emacs Lisp functions  -*- lexical-binding: t -*-
 
-;; Copyright (C) 1993, 1998, 2000-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1998, 2000-2012 Free Software Foundation, Inc.
 
 ;; Author: Hans Chalupsky <hans@cs.buffalo.edu>
 ;; Maintainer: FSF
@@ -151,18 +151,15 @@
 
 ;;; Code:
 
-(require 'advice)
-
 (defgroup trace nil
   "Tracing facility for Emacs Lisp functions."
   :prefix "trace-"
   :group 'lisp)
 
 ;;;###autoload
-(defcustom trace-buffer (purecopy "*trace-output*")
+(defcustom trace-buffer "*trace-output*"
   "Trace output will by default go to that buffer."
-  :type 'string
-  :group 'trace)
+  :type 'string)
 
 ;; Current level of traced function invocation:
 (defvar trace-level 0)
@@ -176,78 +173,109 @@
 (defvar inhibit-trace nil
   "If non-nil, all tracing is temporarily inhibited.")
 
-(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
-          (let ((print-circle t))
-            (mapconcat (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:
-	  (let ((print-circle t)) (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
-   `(advice
-     lambda ()
-     (let ((trace-level (1+ trace-level))
-	   (trace-buffer (get-buffer-create ,buffer)))
-       (unless inhibit-trace
-	 (with-current-buffer trace-buffer
-	   (set (make-local-variable 'window-point-insertion-type) t)
-           ,(unless background '(display-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
-       (unless inhibit-trace
-	 (with-current-buffer trace-buffer
-	   ,(unless background '(display-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-entry-message (function level args context)
+  "Generate a string that describes that FUNCTION has been entered.
+LEVEL is the trace level, ARGS is the list of arguments passed to FUNCTION,
+and CONTEXT is a string describing the dynamic context (e.g. values of
+some global variables)."
+  (let ((print-circle t))
+    (format "%s%s%d -> %S%s\n"
+            (mapconcat 'char-to-string (make-string (1- level) ?|) " ")
+            (if (> level 1) " " "")
+            level
+            (cons function args)
+            context)))
+
+(defun trace-exit-message (function level value context)
+  "Generate a string that describes that FUNCTION has exited.
+LEVEL is the trace level, VALUE value returned by FUNCTION,
+and CONTEXT is a string describing the dynamic context (e.g. values of
+some global variables)."
+  (let ((print-circle t))
+    (format "%s%s%d <- %s: %S%s\n"
+            (mapconcat 'char-to-string (make-string (1- level) ?|) " ")
+            (if (> level 1) " " "")
+            level
+            function
+            ;; Do this so we'll see strings:
+            value
+            context)))
+
+(defvar trace--timer nil)
+
+(defun trace-make-advice (function buffer background context)
+  "Build the piece of advice to be added to trace FUNCTION.
+FUNCTION is the name of the traced function.
+BUFFER is the buffer where the trace should be printed.
+BACKGROUND if nil means to display BUFFER.
+CONTEXT if non-nil should be a function that returns extra info that should
+be printed along with the arguments in the trace."
+  (lambda (body &rest args)
+    (let ((trace-level (1+ trace-level))
+          (trace-buffer (get-buffer-create buffer))
+          (ctx (funcall context)))
+      (unless inhibit-trace
+        (with-current-buffer trace-buffer
+          (set (make-local-variable 'window-point-insertion-type) t)
+          (unless (or background trace--timer
+                      (get-buffer-window trace-buffer 'visible))
+            (setq trace--timer
+                  ;; Postpone the display to some later time, in case we
+                  ;; can't actually do it now.
+                  (run-with-timer 0 nil
+                                  (lambda ()
+                                    (setq trace--timer nil)
+                                    (display-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 args ctx))))
+      (let ((result))
+        (unwind-protect
+            (setq result (list (apply body args)))
+          (unless inhibit-trace
+            (let ((ctx (funcall context)))
+              (with-current-buffer trace-buffer
+                (unless background (display-buffer trace-buffer))
+                (goto-char (point-max))
+                (insert
+                 (trace-exit-message
+                  function
+                  trace-level
+                  (if result (car result) '\!non-local\ exit\!)
+                  ctx))))))
+        (car result)))))
+
+(defun trace-function-internal (function buffer background context)
+  "Add trace advice for FUNCTION."
+  (advice-add
+   function :around
+   (trace-make-advice function (or buffer trace-buffer) background
+                      (or context (lambda () "")))
+   `((name . ,trace-advice-name))))
 
 (defun trace-is-traced (function)
-  (ad-find-advice function 'around trace-advice-name))
+  (advice-member-p trace-advice-name function))
+
+(defun trace--read-args (prompt)
+  (cons
+   (intern (completing-read prompt obarray 'fboundp t))
+   (when current-prefix-arg
+     (list
+      (read-buffer "Output to buffer: " trace-buffer)
+      (let ((exp
+             (let ((minibuffer-completing-symbol t))
+               (read-from-minibuffer "Context expression: "
+                                     nil read-expression-map t
+                                     'read-expression-history))))
+        `(lambda ()
+           (let ((print-circle t))
+             (concat " [" (prin1-to-string ,exp) "]"))))))))
 
 ;;;###autoload
-(defun trace-function (function &optional buffer)
+(defun trace-function-foreground (function &optional buffer context)
   "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
@@ -255,14 +283,11 @@ 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))
+  (interactive (trace--read-args "Trace function: "))
+  (trace-function-internal function buffer nil context))
 
 ;;;###autoload
-(defun trace-function-background (function &optional buffer)
+(defun trace-function-background (function &optional buffer context)
   "Traces FUNCTION with trace output going quietly to BUFFER.
 When this tracing is enabled, every call to FUNCTION writes
 a Lisp-style trace message (showing the arguments and return value)
@@ -272,12 +297,11 @@ The trace output goes to BUFFER quietly, without changing
 the window or buffer configuration.
 
 BUFFER defaults to `trace-buffer'."
-  (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))
+  (interactive (trace--read-args "Trace function in background: "))
+  (trace-function-internal function buffer t context))
+
+;;;###autoload
+(defalias 'trace-function 'trace-function-foreground)
 
 (defun untrace-function (function)
   "Untraces FUNCTION and possibly activates all remaining advice.
@@ -285,16 +309,14 @@ 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)))
-  (when (trace-is-traced function)
-    (ad-remove-advice function 'around trace-advice-name)
-    (ad-update function)))
+   (list (intern (completing-read "Untrace function: "
+                                  obarray #'trace-is-traced t))))
+  (advice-remove function trace-advice-name))
 
 (defun untrace-all ()
   "Untraces all currently traced functions."
   (interactive)
-  (ad-do-advised-functions (function)
-    (untrace-function function)))
+  (mapatoms #'untrace-function))
 
 (provide 'trace)
 
diff --git a/lisp/emacs-lisp/unsafep.el b/lisp/emacs-lisp/unsafep.el
index 0f08d77d4c3..11256c294d9 100644
--- a/lisp/emacs-lisp/unsafep.el
+++ b/lisp/emacs-lisp/unsafep.el
@@ -1,6 +1,6 @@
 ;;;; unsafep.el -- Determine whether a Lisp form is safe to evaluate
 
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
 
 ;; Author: Jonathan Yavner <jyavner@member.fsf.org>
 ;; Maintainer: Jonathan Yavner <jyavner@member.fsf.org>
diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el
index 7f3657bbbe6..ab35d8f3d8f 100644
--- a/lisp/emacs-lisp/warnings.el
+++ b/lisp/emacs-lisp/warnings.el
@@ -1,6 +1,6 @@
 ;;; warnings.el --- log and display warnings
 
-;; Copyright (C) 2002-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2012 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: internal