Merge from trunk.

1 files changed, 706 insertions, 689 deletions

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